Index: Makefile.in =================================================================== diff -u -rd6b5b0c4055205d54d3cffa4654b13da05aeb7ab -r9333bfa110291a29fa898b0ce554e8848db5d031 --- Makefile.in (.../Makefile.in) (revision d6b5b0c4055205d54d3cffa4654b13da05aeb7ab) +++ Makefile.in (.../Makefile.in) (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -624,7 +624,7 @@ $(TCLSH) $(src_generic_dir)/gentclAPI.tcl $(src_generic_dir)/nsfAPI.decls > $(src_generic_dir)/nsfAPI.h aolstub.$(OBJEXT): $(src_generic_dir)/aolstub.c $(PKG_HEADERS) -nsf.$(OBJEXT): $(src_generic_dir)/nsf.c $(src_generic_dir)/predefined.h $(src_generic_dir)/nsfAccessInt.h $(src_generic_dir)/nsfAPI.h $(PKG_HEADERS) $(src_generic_dir)/nsfStack.c $(DTRACE_HDR) +nsf.$(OBJEXT): $(src_generic_dir)/nsf.c $(src_generic_dir)/predefined.h $(src_generic_dir)/nsfAccessInt.h $(src_generic_dir)/nsfAPI.h $(PKG_HEADERS) $(src_generic_dir)/nsfStack.c $(src_generic_dir)/asm/nsfAssemble.c $(src_generic_dir)/asm/nsfAsmExecuteCallThreading.c $(src_generic_dir)/asm/nsfAsmExecuteLabelThreading.c $(src_generic_dir)/asm/nsfAsmAssemble.c $(DTRACE_HDR) nsfDebug.$(OBJEXT): $(src_generic_dir)/nsfDebug.c $(PKG_HEADERS) nsfError.$(OBJEXT): $(src_generic_dir)/nsfError.c $(PKG_HEADERS) nsfMetaData.$(OBJEXT): $(src_generic_dir)/nsfMetaData.c $(PKG_HEADERS) Fisheye: Tag 9333bfa110291a29fa898b0ce554e8848db5d031 refers to a dead (removed) revision in file `asm.tcl'. Fisheye: No comparison available. Pass `N' to diff? Index: configure =================================================================== diff -u -r21336c95f6123ebf608e5ab45b9674cffba35303 -r9333bfa110291a29fa898b0ce554e8848db5d031 --- configure (.../configure) (revision 21336c95f6123ebf608e5ab45b9674cffba35303) +++ configure (.../configure) (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -740,6 +740,7 @@ enable_memcount enable_development enable_assertions +enable_assemble with_tcl with_tclinclude enable_threads @@ -1378,6 +1379,8 @@ --enable-development build nsf with development support (intensive runtime checking, etc.; default: disabled) --enable-assertions build nsf with assertion support (default: enabled) + --enable-assemble=yes|label|call + build nsf with assemble support (default: disabled) --enable-threads build with threads --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (default: off) @@ -2377,7 +2380,14 @@ enable_assertions=yes fi +# Check whether --enable-assemble was given. +if test "${enable_assemble+set}" = set; then : + enableval=$enable_assemble; enable_assemble=$enableval +else + enable_assemble=no +fi + subdirs="" test_actiweb="" @@ -5513,6 +5523,22 @@ fi +if test "$enable_assemble" = yes; then + +$as_echo "#define NSF_ASSEMBLE 1" >>confdefs.h + +fi +if test "$enable_assemble" = call; then + +$as_echo "#define NSF_ASSEMBLE_CT 1" >>confdefs.h + +fi +if test "$enable_assemble" = call; then + +$as_echo "#define NSF_ASSEMBLE_LT 1" >>confdefs.h + +fi + DTRACE_OBJ= if test "$with_dtrace" = yes; then Index: configure.in =================================================================== diff -u -r21336c95f6123ebf608e5ab45b9674cffba35303 -r9333bfa110291a29fa898b0ce554e8848db5d031 --- configure.in (.../configure.in) (revision 21336c95f6123ebf608e5ab45b9674cffba35303) +++ configure.in (.../configure.in) (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -52,6 +52,10 @@ AC_HELP_STRING([--enable-assertions], [build nsf with assertion support (default: enabled)]), [enable_assertions=$enableval], [enable_assertions=yes]) +AC_ARG_ENABLE(assemble, + AC_HELP_STRING([--enable-assemble=yes|label|call], + [build nsf with assemble support (default: disabled)]), + [enable_assemble=$enableval], [enable_assemble=no]) subdirs="" @@ -168,6 +172,16 @@ AC_DEFINE(NSF_MEM_TRACE, 1, [Are we building with memcount tracing support?]) fi +if test "$enable_assemble" = yes; then + AC_DEFINE(NSF_ASSEMBLE, 1, [Are we building with assembly support?]) +fi +if test "$enable_assemble" = call; then + AC_DEFINE(NSF_ASSEMBLE_CT, 1, [Are we building with assembly call threading support?]) +fi +if test "$enable_assemble" = call; then + AC_DEFINE(NSF_ASSEMBLE_LT, 1, [Are we building with assembly label threading support?]) +fi + DTRACE_OBJ= if test "$with_dtrace" = yes; then AC_DEFINE(NSF_DTRACE, 1, [Are we building with DTrace support?]) Index: generic/asm/asm.tcl =================================================================== diff -u --- generic/asm/asm.tcl (revision 0) +++ generic/asm/asm.tcl (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,311 @@ +package req nx::test +nx::Test parameter count 100000 +#nx::Test parameter count 10 + +proc sum10.tcl {} { + set sum 0 + for {set i 0} {$i < 100} {incr i} { + incr sum $i + } + return $sum +} +# implementation in assembly, using tcl-objs for +# "sum", "i" and the constants +nsf::asm::proc sum10.asm1 {} { + {obj sum} + {obj i} + {obj 0} + {obj 1} + {obj 100} + {obj 0} + {var obj 0} + {var obj 1} + {duplicateObj slot 6 obj 2} + {duplicateObj slot 7 obj 5} + {leIntObj slot 4 slot 7} + {jumpTrue instruction 7} + {incrObj slot 6 slot 7} + {incrObj slot 7 slot 3} + {jump instruction 2} + {setResult slot 6} +} +# implementation in assembly, using tcl-objs for +# "sum", "i" and the constants +nsf::asm::proc sum10.asm2 {} { + {obj sum} + {obj i} + {integer int 1} + {integer int 100} + {integer int 0} + {integer int 0} + {setInt slot 4 int 0} + {setInt slot 5 int 0} + {leInt slot 3 slot 5} + {jumpTrue instruction 7} + {incrInt slot 4 slot 5} + {incrInt slot 5 slot 2} + {jump instruction 2} + {setResultInt slot 4} +} + +? {sum10.tcl} "4950" +? {sum10.asm1} "4950" +? {sum10.asm2} "4950" + +#exit + +proc incr1.tcl {x} { + incr x +} +# currently we have to set the local var of the argument +nsf::asm::proc incr1.asm1 {x} { + {obj x} + {obj 1} + {cmd ::set obj 0 arg 0} + {cmd ::incr obj 0 obj 1} +} +nsf::asm::proc incr1.asm2 {x} { + {obj x} + {obj 1} + {var obj 0} + {setObj slot 2 arg 0} + {incrObj slot 2 slot 1} + {setResult slot 2} +} +? {incr1.tcl 10} "11" +? {incr1.asm1 10} "11" +? {incr1.asm2 10} "11" + +proc incr2.tcl {x} { + set a $x + incr a +} +nsf::asm::proc incr2.asm1 {x} { + {obj a} + {obj 1} + {cmd ::set obj 0 arg 0} + {cmd ::incr obj 0 obj 1} +} +nsf::asm::proc incr2.asm2 {x} { + {obj a} + {obj 1} + {var obj 0} + {setObj slot 2 arg 0} + {incrObj slot 2 slot 1} + {setResult slot 2} +} +? {incr2.tcl 13} "14" +? {incr2.asm1 13} "14" +? {incr2.asm2 13} "14" + +proc foo.tcl {x} { + set a 1 + set b $x + incr a [incr b] + return $a +} +nsf::asm::proc foo.asm1 {x} { + {obj a} + {obj b} + {obj 1} + {cmd ::set obj 0 obj 2} + {cmd ::set obj 1 arg 0} + {cmd ::incr obj 1} + {store instruction 4 argv 2} + {cmd ::incr obj 0 result 3} + {cmd ::set obj 0} +} +nsf::asm::proc foo.asm2 {x} { + {obj a} + {obj b} + {obj 1} + {var obj 0} + {var obj 1} + {var obj 2} + {setObj slot 3 obj 2} + {setObj slot 4 arg 0} + {incrObj slot 4 slot 2} + {setObjToResult slot 5} + {incrObj slot 3 slot 5} + {cmd ::set obj 0} +} +? {foo.tcl 100} "102" +? {foo.asm1 100} "102" +? {foo.asm2 100} "102" +#exit + + +proc bar.tcl {x} {concat [format %c 64] - [format %c 65] - $x} +nsf::asm::proc bar.asm {x} { + {obj %c} + {obj -} + {obj 64} + {obj 65} + {cmd ::format obj 0 obj 2} + {store instruction 4 argv 1} + {cmd ::format obj 0 obj 3} + {store instruction 4 argv 3} + {cmd ::concat result 1 obj 1 result 3 obj 1 arg 0} +} +#puts [bar.asm 123] +? {bar.tcl 123} "@ - A - 123" +? {bar.asm 123} "@ - A - 123" + +proc create1.tcl {} {nx::Object create o1} +nsf::asm::proc create1.asm1 {} { + {obj ::nx::Object} + {obj create} + {obj o1} + {eval obj 0 obj 1 obj 2} +} +nsf::asm::proc create1.asm2 {} { + {obj create} + {obj o1} + {cmd ::nx::Object obj 0 obj 1} +} +nsf::asm::proc create1.asm3 {} { + {obj nx::Object} + {obj ::nsf::methods::class::create} + {obj o1} + {methodDelegateDispatch obj 0 obj 1 obj 2} +} +nsf::asm::proc create1.asm4 {} { + {obj ::nx::Object} + {obj ::nsf::methods::class::create} + {obj o1} + {methodDelegateDispatch obj 0 obj 1 obj 2} +} + +? {create1.tcl} "::o1" +? {create1.asm1} "::o1" +? {create1.asm2} "::o1" +? {create1.asm3} "::o1" +? {create1.asm4} "::o1" + +proc create2.tcl {} {nx::Object create o1;o1 destroy;::nsf::object::exists o1} +nsf::asm::proc create2.asm1 {} { + {obj create} + {obj o1} + {obj destroy} + {cmd ::nx::Object obj 0 obj 1} + {eval obj 1 obj 2} + {cmd ::nsf::object::exists obj 1} +} +nsf::asm::proc create2.asm2 {} { + {obj o1} + {obj nx::Object} + {obj ::nsf::methods::class::create} + {obj ::nsf::methods::object::destroy} + {methodDelegateDispatch obj 1 obj 2 obj 0} + {methodDelegateDispatch obj 0 obj 3} + {cmd ::nsf::object::exists obj 0} +} +nsf::asm::proc create2.asm3 {} { + {obj o1} + {obj ::nx::Object} + {obj ::nsf::methods::class::create} + {obj ::nsf::methods::object::destroy} + {methodDelegateDispatch obj 1 obj 2 obj 0} + {methodDelegateDispatch obj 0 obj 3} + {cmd ::nsf::object::exists obj 0} +} +? {create2.tcl} 0 +? {create2.asm1} 0 +? {create2.asm2} 0 +? {create2.asm3} 0 + +proc check_obj.tcl {} {::nsf::object::exists o1} +nsf::asm::proc check_obj.asm1 {} { + {obj o1} + {cmd ::nsf::object::exists obj 0} +} +nsf::asm::proc check_obj.asm2 {} { + {obj o1} + {obj ::nsf::object::exists} + {eval obj 1 obj 0} +} +? {check_obj.tcl} 0 +? {check_obj.asm1} 0 +? {check_obj.asm2} 0 + +nx::Object create o { + set :x 1 +} +nsf::method::create o check_obj.tcl {} {::nsf::object::exists o1} +nsf::method::asmcreate o check_obj.asm1 {} { + {obj o1} + {cmd ::nsf::object::exists obj 0} +} +nsf::method::asmcreate o check_obj.asm2 {} { + {obj o1} + {obj ::nsf::object::exists} + {eval obj 1 obj 0} +} +? {o check_obj.tcl} 0 +? {o check_obj.asm1} 0 +? {o check_obj.asm2} 0 + +# info exists is byte-compiled +nsf::method::create o check_var1.tcl {} {info exists :x} +nsf::method::asmcreate o check_var1.asm1 {} { + {obj exists} + {obj :x} + {cmd ::info obj 0 obj 1} +} +? {o check_var1.tcl} 1 +? {o check_var1.asm1} 1 + +# check for existence via method +nsf::method::create o check_var2.tcl {} { + : ::nsf::methods::object::exists x +} +nsf::method::asmcreate o check_var2.asm1 {} { + {obj :} + {obj ::nsf::methods::object::exists} + {obj x} + {eval obj 0 obj 1 obj 2} +} +nsf::method::asmcreate o check_var2.asm2 {} { + {obj ::o} + {obj ::nsf::methods::object::exists} + {obj x} + {methodDelegateDispatch obj 0 obj 1 obj 2} +} +nsf::method::asmcreate o check_var2.asm3 {} { + {obj nsf::methods::object::exists} + {obj x} + {methodSelfDispatch obj 0 obj 1} +} +nsf::method::asmcreate o check_var2.asm4 {} { + {obj ::nsf::methods::object::exists} + {obj x} + {methodSelfDispatch obj 0 obj 1} +} +? {o check_var2.tcl} 1 +? {o check_var2.asm1} 1 +? {o check_var2.asm2} 1 +? {o check_var2.asm3} 1 +? {o check_var2.asm4} 1 + +# +# self +# +nsf::method::create o self.tcl {} { + self +} +nsf::method::asmcreate o self.asm1 {} { + {obj self} + {eval obj 0} +} +nsf::method::asmcreate o self.asm2 {} { + {cmd self} +} +nsf::method::asmcreate o self.asm3 {} { + {self} +} + +? {o self.tcl} ::o +? {o self.asm1} ::o +? {o self.asm2} ::o +? {o self.asm3} ::o + Index: generic/asm/asmAssembleTemplate.c =================================================================== diff -u --- generic/asm/asmAssembleTemplate.c (revision 0) +++ generic/asm/asmAssembleTemplate.c (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,274 @@ +enum asmStatementIndex { + asmObjProcIdx, + $STATEMENT_INDICES +}; + +static CONST char *asmStatementNames[] = { + "cmd", + $STATEMENT_NAMES, + NULL +}; + +enum asmStatmentArgTypeIndex { + asmStatementArgTypeArgIdx, + asmStatementArgTypeArgvIdx, + asmStatementArgTypeInstructionIdx, + asmStatementArgTypeIntIdx, + asmStatementArgTypeObjIdx, + asmStatementArgTypeResultIdx, + asmStatementArgTypeSlotIdx, + asmStatementArgTypeVarIdx +}; + +static CONST char *asmStatementArgType[] = { + "arg", + "argv", + "instruction", + "int", + "obj", + "result", + "slot", + "var", + NULL}; + +static CONST char *asmStatementCmdType[] = {"arg", "obj", "result", "var", NULL}; +static CONST char *asmStatementInstructionType[] = {"instruction", NULL}; +static CONST char *asmStatementIntType[] = {"int", NULL}; +static CONST char *asmStatementObjType[] = {"obj", NULL}; +static CONST char *asmStatementSlotObjArgType[] = {"slot", "obj", "arg", NULL}; +static CONST char *asmStatementSlotType[] = {"slot", NULL}; +static CONST char *asmStatementSlotIntType[] = {"slot", "int", NULL}; +static CONST char *asmStatementStoreType[] = {"instruction", "argv", NULL}; + +static AsmStatementInfo asmStatementInfo[] = { + /* asmObjProcIdx, */ + {ASM_INFO_PAIRS|ASM_INFO_SKIP1, NULL, 2, -1, NR_PAIRS1}, + $STATEMENT_INFO +}; + + +/* + *---------------------------------------------------------------------- + * AsmAssemble -- + * + * The assmbler, takes an assembly script in the form of a nested + * list and emits the internal representation for the execution + * enigine. + * + *---------------------------------------------------------------------- + */ + +static int +AsmAssemble(ClientData cd, Tcl_Interp *interp, Tcl_Obj *nameObj, + int nrArgs, Tcl_Obj *asmObj, AsmCompiledProc **retAsmProc) { + AsmPatches patchArray[100], *patches = &patchArray[0], *patchPtr; // TODO: make me dynamic + Tcl_Command cmd; + AsmCompiledProc *proc; + AsmInstruction *inst; + int i, result, nrAsmInstructions, nrLocalObjs, totalArgvArgs; + int oc, currentAsmInstruction, currentSlot; + Tcl_Obj **ov; + CONST char *procName; + + assert(nameObj); + procName = ObjStr(nameObj); + + if (Tcl_ListObjGetElements(interp, asmObj, &oc, &ov) != TCL_OK) { + return NsfPrintError(interp, "Asm code is not a valid list"); + } + + /* + * First Iteration: check wellformedness, determine sizes + */ + nrAsmInstructions = 0; + nrLocalObjs = 0; + totalArgvArgs = 0; + + for (i = 0; i < oc; i++) { + int index, offset, wordOc; + Tcl_Obj *lineObj = ov[i], **wordOv; + + if (Tcl_ListObjGetElements(interp, lineObj, &wordOc, &wordOv) != TCL_OK) { + return NsfPrintError(interp, + "Asm: line is not a well-formed asm instruction: %s", + ObjStr(lineObj)); + } + + result = Tcl_GetIndexFromObj(interp, wordOv[0], asmStatementNames, "asm instruction", 0, &index); + if (result != TCL_OK) { + return NsfPrintError(interp, + "Asm: line is not a valid asm instruction: word %s, line %s", + ObjStr(wordOv[0]), ObjStr(lineObj)); + } + + offset = (asmStatementInfo[index].flags & ASM_INFO_SKIP1) ? 2 : 1; + + if ((asmStatementInfo[index].flags & ASM_INFO_PAIRS) && (wordOc-offset) % 2 == 1) { + return NsfPrintError(interp, "Asm: argument list of cmd must contain pairs: %s", + ObjStr(lineObj)); + } + + if (asmStatementInfo[index].minArgs > -1 + && wordOc < asmStatementInfo[index].minArgs) { + return NsfPrintError(interp, "Asm: statement must contain at least %d words: %s", + asmStatementInfo[index].minArgs, ObjStr(lineObj)); + } + + if (asmStatementInfo[index].maxArgs > -1 + && wordOc > asmStatementInfo[index].maxArgs) { + return NsfPrintError(interp, "Asm: statement must contain at most %d words: %s", + asmStatementInfo[index].maxArgs, ObjStr(lineObj)); + } + + if (asmStatementInfo[index].argTypes) { + result = AsmInstructionArgvCheck(interp, offset, wordOc, + asmStatementInfo[index].argTypes, + nrLocalObjs, oc, wordOv, lineObj); + if (unlikely(result != TCL_OK)) {return result;} + } + + if ((asmStatementInfo[index].flags & ASM_INFO_DECL) == 0) { + int cArgs = asmStatementInfo[index].cArgs; + /* + * Determine the actual number of arguments passed to the + * emitted instruction. This number might be determine by the + * instruction type, or by the actual instruction being + * processed (and later maybe for {*} etc.). + */ + if (cArgs == NR_PAIRS) { + cArgs = (wordOc-offset) / 2; + } else if (cArgs == NR_PAIRS1) { + cArgs = 1 + (wordOc-offset) / 2; + } + //fprintf(stderr, "instruction %s need argvargs %d\n", ObjStr(lineObj), cArgs); + totalArgvArgs += cArgs; + + nrAsmInstructions++; + } else { + /* currently obj and var from the same pool, will change... */ + nrLocalObjs ++; + } + + /* + * optional, per-statement check operations + */ + switch (index) { + case asmObjProcIdx: + /* {cmd ::set slot 0 slot 2} */ + cmd = Tcl_GetCommandFromObj(interp, wordOv[1]); + if (cmd == NULL) { + return NsfPrintError(interp, + "Asm: cmd is not a valid tcl command: %s\n", + Tcl_GetString( wordOv[1])); + } + break; + + /* begin generated code */ + $ASSEMBLE_CHECK_CODE + /* end generated code */ + + default: + break; + } + } + + nrAsmInstructions ++; + fprintf(stderr, "%s: nrAsmInstructions %d nrLocalObjs %d nrArgs %d argvArgs %d => data %d\n", + procName, nrAsmInstructions, nrLocalObjs, nrArgs, totalArgvArgs, + nrLocalObjs + nrArgs + totalArgvArgs ); + + /* + * Allocate structures + */ + + proc = (AsmCompiledProc *)ckalloc(sizeof(AsmCompiledProc)); + proc->code = (AsmInstruction *)ckalloc(sizeof(AsmInstruction) * nrAsmInstructions); + memset(proc->slotFlags, 0, sizeof(int) * NSF_ASM_NR_STATIC_SLOTS); + + proc->ip = proc->code; /* points to the first writable instructon */ + proc->firstObj = proc->staticObjs; /* point to the first free obj */ + proc->locals = proc->staticObjs; /* locals is just an alias */ + proc->nrAsmArgReferences = 0; + proc->slots = proc->locals + nrArgs; + //fprintf(stderr, "args = %ld\n", proc->slots - proc->locals); + + AsmLocalsAlloc(proc, nrArgs + nrLocalObjs); + /* when freeing, we need something like + for (i=0; i < nrArgs + nrLocalObjs; i++) { + if (proc->slotFlags[i] & ASM_SLOT_MUST_DECR) {Tcl_DecrRefCount(proc->slots[i]); } + } + */ + + /* + * Second Iteration: emit code + */ + currentSlot = 0; + currentAsmInstruction = 0; + + for (i = 0; i < oc; i++) { + int index, offset, cArgs, argc, codeIndex, argvIndex, j; + Tcl_Obj *lineObj = ov[i], **argv; + + Tcl_ListObjGetElements(interp, lineObj, &argc, &argv); + Tcl_GetIndexFromObj(interp, argv[0], asmStatementNames, "asm instruction", 0, &index); + + offset = (asmStatementInfo[index].flags & ASM_INFO_SKIP1) ? 2 : 1; + + cArgs = asmStatementInfo[index].cArgs; + if (cArgs == NR_PAIRS) { + cArgs = (argc-offset) / 2; + } else if (cArgs == NR_PAIRS1) { + cArgs = 1 + (argc-offset) / 2; + } + + switch (index) { + + case asmObjProcIdx: + /* {cmd ::set slot 0 slot 2} */ + cmd = Tcl_GetCommandFromObj(interp, argv[1]); +#if defined(LABEL_THREADING) + inst = AsmInstructionNew(proc, objProc, cArgs); + inst->cmd = ((Command *)cmd)->objProc; +#else + inst = AsmInstructionNew(proc, ((Command *)cmd)->objProc, cArgs); +#endif + inst->clientData = ((Command *)cmd)->objClientData; + /* use the assembly word as cmd name; should be ok when we keep assembly around */ + inst->argv[0] = argv[1]; + /*fprintf(stderr, "[%d] %s/%d\n", currentAsmInstruction, Tcl_GetString(argv[1]), 1+((argc-offset)/2));*/ + + AsmInstructionArgvSet(interp, offset, argc, 1, inst, proc, argv, 0); + break; + + /* begin generated code */ +$ASSEMBLE_EMIT_CODE + /* end generated code */ + } + + if ((asmStatementInfo[index].flags & ASM_INFO_DECL) == 0) { + currentAsmInstruction ++; + } + } + + /* + * add END instruction + */ + inst = AsmInstructionNew(proc, NULL, 0); + + /* + * All addresses are determined, apply the argv patches triggered + * from above. + */ + + for (patchPtr = &patchArray[0]; patchPtr < patches; patchPtr++) { + fprintf(stderr, "wanna patch code[%d]->argv = code[%d]->argv[%d]\n", + patchPtr->targetAsmInstruction, patchPtr->sourceAsmInstruction, patchPtr->argvIndex); + /* set the argument vector of code[1] to the address of code[4]->argv[1] */ + (&proc->code[patchPtr->targetAsmInstruction])->argv = + &(&proc->code[patchPtr->sourceAsmInstruction])->argv[patchPtr->argvIndex]; + } + + *retAsmProc = proc; + + return TCL_OK; +} Index: generic/asm/asmExecuteTemplate.c =================================================================== diff -u --- generic/asm/asmExecuteTemplate.c (revision 0) +++ generic/asm/asmExecuteTemplate.c (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,70 @@ +int AsmExecute(ClientData cd, Tcl_Interp *interp, AsmCompiledProc *proc, int argc, Tcl_Obj *CONST argv[]) { + int i, result, indexValue; + ClientData clientData; + NsfObject *object; + Tcl_Command cmd; + AsmInstruction *ip; + + static void *instructionLabel[] = { + &&INST_objProc, + &&INST_asmStoreResult, + &&INST_asmSetResult, + &&INST_asmNoop, + &&INST_asmDispatch, + &&INST_asmMethodDelegateDispatch00, + &&INST_asmMethodDelegateDispatch11, + &&INST_asmMethodSelfDispatch, + &&INST_asmMethodSelfCmdDispatch, + &&INST_asmMethodSelf, + &&INST_asmJump, + &&INST_asmJumpTrue, + &&INST_asmLeScalar, + &&INST_asmCopyScalar, + &&INST_asmSetScalar, + &&INST_asmSetScalarResult, + &&INST_asmIncrScalar, + &&INST_NULL + }; + + + /* + * Place a copy of the actual argument into locals. + */ + for (i=1; i < argc; i++) { + proc->locals[i-1] = argv[i]; + } + /* + * Update all references to compiled arguments. + */ + for (i=0; i < proc->nrAsmArgReferences; i++) { + AsmArgReference *arPtr = &proc->argReferences[i]; + *(arPtr->objPtr) = proc->locals[arPtr->argNr]; + } + + /* + * Set the instruction pointer to the begin of the code. + */ + ip = proc->code; + proc->status = 0; + + //fprintf(stderr, "AsmExecute jumps to %p\n", ip); + + goto *instructionLabel[ip->labelIdx]; + + INST_NULL: + return result; + + EXEC_RESULT_CODE_HANDLER: + if (likely(result == TCL_OK)) { + ip++; + goto *instructionLabel[ip->labelIdx]; + } else { + return result; + } + + INST_objProc: + result = (*ip->cmd)(ip->clientData, interp, ip->argc, ip->argv); + goto EXEC_RESULT_CODE_HANDLER; + + GENERATED_INSTRUCTIONS; +} Index: generic/asm/asmExecuteTemplateCallThreading.c =================================================================== diff -u --- generic/asm/asmExecuteTemplateCallThreading.c (revision 0) +++ generic/asm/asmExecuteTemplateCallThreading.c (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,62 @@ + +$GENERATED_INSTRUCTIONS; + +/* + *---------------------------------------------------------------------- + * AsmExecute -- + * + * Define the execution engine for the code + * + *---------------------------------------------------------------------- + */ +static int +AsmExecute(ClientData cd, Tcl_Interp *interp, AsmCompiledProc *proc, int argc, Tcl_Obj *CONST argv[]) { + //AsmInstruction *ip; + int i, result; + +#if 0 + Var *compiledLocals; + + compiledLocals = ((Interp *) interp)->varFramePtr->compiledLocals; + if (compiledLocals) { + fprintf(stderr, "compiledLocals = %p\n", compiledLocals); + } +#endif + + /* + * Place a copy of the actual argument into locals. + */ + for (i=1; i < argc; i++) { + proc->locals[i-1] = argv[i]; + } + /* + * Update all references to compiled arguments. + */ + for (i=0; i < proc->nrAsmArgReferences; i++) { + AsmArgReference *arPtr = &proc->argReferences[i]; + *(arPtr->objPtr) = proc->locals[arPtr->argNr]; + } + + /* + * Set the instruction pointer to the begin of the code. + */ + proc->ip = proc->code; + //fprintf(stderr, "ip %p\n", proc->ip); + + while (*proc->ip->cmd) { + //fprintf(stderr, "will execute instruction ip %p cmd %p %p/%d\n", ip, ip->cmd, ip->argv[0], ip->argc); + //if (ip->cmd == tclFormat) {AsmInstructionPrint(ip);} + //if (ip->cmd == (Tcl_ObjCmdProc*)tclDispatch) {AsmInstructionPrint(ip);} + result = (*proc->ip->cmd)(proc->ip->clientData, interp, proc->ip->argc, proc->ip->argv); + /*fprintf(stderr, "%s returned <%s> (%d)\n", + Tcl_GetString(ip->argv[0]), + Tcl_GetString(Tcl_GetObjResult(interp)), result);*/ + if (unlikely(result != TCL_OK)) break; + proc->ip++; + //fprintf(stderr, "ip %p\n", proc->ip); + } + + return result; +} + + Index: generic/asm/asmExecuteTemplateLabelThreading.c =================================================================== diff -u --- generic/asm/asmExecuteTemplateLabelThreading.c (revision 0) +++ generic/asm/asmExecuteTemplateLabelThreading.c (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,68 @@ + +enum instructionIdx { + IDX_objProc, + $INSTRUCTION_INDICES, + IDX_NULL +}; + +/* + *---------------------------------------------------------------------- + * AsmExecute -- + * + * Define the execution engine for the code + * + *---------------------------------------------------------------------- + */ +int AsmExecute(ClientData cd, Tcl_Interp *interp, AsmCompiledProc *proc, int argc, Tcl_Obj *CONST argv[]) { + int i, result; + AsmInstruction *ip; + + static void *instructionLabel[] = { + &&INST_objProc, + $INSTRUCTION_LABELS, + &&INST_NULL + }; + + + /* + * Place a copy of the actual argument into locals. + */ + for (i=1; i < argc; i++) { + proc->locals[i-1] = argv[i]; + } + /* + * Update all references to compiled arguments. + */ + for (i=0; i < proc->nrAsmArgReferences; i++) { + AsmArgReference *arPtr = &proc->argReferences[i]; + *(arPtr->objPtr) = proc->locals[arPtr->argNr]; + } + + /* + * Set the instruction pointer to the begin of the code. + */ + ip = proc->code; + proc->status = 0; + + //fprintf(stderr, "AsmExecute jumps to %p\n", ip); + + goto *instructionLabel[ip->labelIdx]; + + INST_NULL: + return result; + + EXEC_RESULT_CODE_HANDLER: + if (likely(result == TCL_OK)) { + ip++; + goto *instructionLabel[ip->labelIdx]; + } else { + return result; + } + + INST_objProc: + result = (*ip->cmd)(ip->clientData, interp, ip->argc, ip->argv); + goto EXEC_RESULT_CODE_HANDLER; + + $GENERATED_INSTRUCTIONS +} + Index: generic/asm/genAssemble.tcl =================================================================== diff -u --- generic/asm/genAssemble.tcl (revision 0) +++ generic/asm/genAssemble.tcl (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,682 @@ +package require nx +###################################################################### +# The code engine +###################################################################### + +nsf::proc generate {threadingType:class} { + set suffix [string trimleft ${threadingType} :] + set dirName [file dirname [info script]] + + foreach {var value} [${threadingType} generate] { + set $var $value + } + + set template [readFile $dirName/asmExecuteTemplate$suffix.c] + writeFile $dirName/nsfAsmExecute$suffix.c [subst -nocommand -nobackslash $template] + + set template [readFile $dirName/asmAssembleTemplate.c] + writeFile $dirName/nsfAsmAssemble.c [subst -nocommand -nobackslash $template] +} + +nsf::proc readFile {fn} {set f [open $fn]; set content [read $f]; close $f; return $content} +nsf::proc writeFile {fn content} { + puts stderr "writing $fn" + set f [open $fn w]; puts -nonewline $f $content; close $f +} + + +###################################################################### +# Basic Class for Instructions and Declarations +###################################################################### +nx::Class create Statement { + :property {name "[namespace tail [self]]"} + :property {mustContainPairs true} + :property {argTypes NULL} + :property {minArgs 0} + :property {maxArgs 0} + :property {cArgs 0} + + :property {asmCheckCode ""} + :property {asmEmitCode ""} + + :public method cName {} { + # prepend asm and capitalize first character + return asm[string toupper [string range ${:name} 0 0]][string range ${:name} 1 end] + } + :public method getAsmEmitCode {} { + return ${:asmEmitCode} + } + + :public class method "generate assembler" {} { + set statementIndex {} + set statementNames {} + set (ASSEMBLE_EMIT_CODE) "" + foreach s [lsort [Statement info instances -closure]] { + if {[$s maxArgs] == 0} { + puts stderr "ignore statement $s" + continue + } + lappend statementIndex [$s cName]Idx + lappend statementNames \"[$s name]\" + + set emitCode [$s getAsmEmitCode] + if {$emitCode ne ""} { + append (ASSEMBLE_EMIT_CODE) " case [$s cName]Idx:\n$emitCode\n break;\n\n" + } + + set flags 0 + if {[$s info has type ::Declaration]} { + lappend flags ASM_INFO_DECL + } + if {[$s mustContainPairs]} { + lappend flags ASM_INFO_PAIRS + } + lappend statementInfo \ + "/* [$s cName] */\n {[join $flags |], [$s argTypes], [$s minArgs], [$s maxArgs], [$s cArgs]}" + } + array set {} [list \ + STATEMENT_INDICES [join $statementIndex ",\n "] \ + STATEMENT_NAMES [join $statementNames ",\n "] \ + STATEMENT_INFO [join $statementInfo ",\n "] \ + ASSEMBLE_CHECK_CODE ""] + + return [array get {}] + } + +} + +###################################################################### +# Basic Class for Instructions and Declarations +###################################################################### +nx::Class create Declaration -superclass Statement { +} + +###################################################################### +# Basic Class for defining Instructions independent of the code +# generator (label threading, call threading) +###################################################################### + +nx::Class create Instruction -superclass Statement { + :property {execCode ""} + + :property {isJump false} + :property {returnsResult false} + + # The property "execNeedsProc" is just needed for call threading, + # where we have to pass proc via inst->clientData + :property {execNeedsProc false} + + :public method getAsmEmitCode {} { + # + # For every instruction, the C-code allocates an instruction record + # + append . \ + "\n\tinst = AsmInstructionNew(proc, [:cName], cArgs);" \ + "\n\tif (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);}" \ + [:asmEmitCode] + } + + :method "code clear" {} { + set :cCode "" + } + + :method "code get" {} { + return ${:cCode} + } + + :method "code append" {value} { + append :cCode $value + } + + :method "code mustAssign" {value} { + if {![regexp "\\m${value}\\M\\s*=" ${:cCode}]} { + error "code does not assign variable '$value': ${:cCode}" + } + } + + :method "code mustContain" {value} { + if {![regexp ${value} ${:cCode}]} { + error "code does not contain '$value': ${:cCode}" + } + } +} + +###################################################################### +# Code Generator for Label Threading +###################################################################### + +nx::Class create LabelThreading { + + :public class method generate {} { + Instruction mixin add [self]::Instruction + set instructions [lsort [Instruction info instances]] + set labels {} + set indices {} + foreach instruction $instructions { + append (GENERATED_INSTRUCTIONS) [$instruction generate] \n + lappend labels &&[$instruction labelName] + lappend indices IDX_[$instruction cName] + } + + array set {} [list \ + INSTRUCTION_LABELS [join $labels ",\n "] \ + INSTRUCTION_INDICES [join $indices ",\n "] \ + {*}[Statement generate assembler]] + + Instruction mixin delete [self]::Instruction + return [array get {}] + } + + nx::Class create [self]::Instruction { + # + # This Class is designed as a mixin class for Instruction + # + :public method labelName {} { + return INST_[:cName] + } + :method nextInstruction {} { + if {[:isJump]} { + :code mustContain NsfAsmJump + :code append "\n goto *instructionLabel\[ip->labelIdx];\n" + } else { + :code append "\n ip++;\n goto *instructionLabel\[ip->labelIdx];\n" + } + } + :public method "code generate" {} { + :code append ${:execCode} + if {[:returnsResult]} { + :code mustAssign result + :code append " goto EXEC_RESULT_CODE_HANDLER;\n" + } + } + + :public method generate {} { + :code clear + :code append [:labelName]:\n + :code generate + :nextInstruction + return [:code get] + } + } +} + +###################################################################### +# Code Generator for Call Threading +###################################################################### + +nx::Class create CallThreading { + + :public class method generate {} { + Instruction mixin add [self]::Instruction + Statement mixin add [self]::Statement + + foreach instruction [lsort [Instruction info instances]] { + append (GENERATED_INSTRUCTIONS) [$instruction generate] \n + } + + array set {} [Statement generate assembler] + + Instruction mixin delete [self]::Instruction + Statement mixin delete [self]::Statement + + return [array get {}] + } + + nx::Class create [self]::Statement { + + :public method asmEmitCode {} { + set asmEmitCode ${:asmEmitCode} + if {[:execNeedsProc]} { + append asmEmitCode "\n\tinst->clientData = proc;\n" + } + return $asmEmitCode + } + } + + nx::Class create [self]::Instruction { + # + # This Class is designed as a mixin class for Instruction + # + + :public method "code generate" {} { + set code ${:execCode} + regsub -all {\mip->argv\M} $code argv code + regsub -all {\mip->argc\M} $code argc code + regsub -all {\mip->clientData\M} $code clientData code + + if {[:isJump]} { + regsub -all {\mip\s*= } $code "proc->ip = " code + regsub -all {\mip\s*[+][+]} $code "proc->ip++" code + } + + if {[:returnsResult]} { + :code append " int result;\n" + :code append $code + :code mustAssign result + :code append " return result;\n" + } else { + :code append $code + :code append " return TCL_OK;\n" + } + } + + :public method generate {} { + :code clear + :code append \ + "static int [:cName](ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv\[]) \{\n" + if {[:execNeedsProc]} { + :code append " AsmCompiledProc *proc = clientData;\n" + } + :code generate + :code append "\}\n" + return [:code get] + } + } +} + +namespace eval ::asm { + ###################################################################### + # Declarations + ###################################################################### + + # {obj a} + Declaration create obj \ + -mustContainPairs false \ + -minArgs 2 -maxArgs 2 \ + -asmEmitCode { + proc->slots[currentSlot] = argv[1]; + Tcl_IncrRefCount(proc->slots[currentSlot]); + proc->slotFlags[currentSlot] |= ASM_SLOT_MUST_DECR; + currentSlot ++; + } + + # {var obj 0} + # obj is intended to be the varname, but currently ignored + Declaration create var \ + -minArgs 3 -maxArgs 3 -argTypes asmStatementObjType \ + -asmEmitCode { + proc->slots[currentSlot] = NULL; + currentSlot ++; + } + + # {integer int 0} + Declaration create integer \ + -minArgs 3 -maxArgs 3 -argTypes asmStatementIntType \ + -asmEmitCode { + { + int intValue; + Tcl_GetIntFromObj(interp, argv[2], &intValue); + proc->slots[currentSlot] = INT2PTR(intValue); + //fprintf(stderr, "setting slots [%d] = %d\n", currentSlot, intValue); + proc->slotFlags[currentSlot] |= ASM_SLOT_IS_INTEGER; + currentSlot ++; + } + } + + + ###################################################################### + # Instructions + ###################################################################### + + # {noop} + Instruction create noop \ + -mustContainPairs false \ + -minArgs 1 -maxArgs 1 + + # {eval obj 0 obj 1 obj 2} + Instruction create dispatch \ + -name "eval" \ + -minArgs 3 -maxArgs -1 -cArgs NR_PAIRS -argTypes asmStatementCmdType \ + -returnsResult true \ + -execCode { + result = Tcl_EvalObjv(interp, ip->argc, ip->argv, 0); + } + + # {methodDelegateDispatch obj 0 obj 1 obj 2} + Instruction create methodDelegateDispatch \ + -name "methodDelegateDispatch" \ + -minArgs 5 -maxArgs -1 -cArgs NR_PAIRS -argTypes asmStatementCmdType \ + -asmEmitCode { + { Tcl_Command cmd = NULL; + NsfObject *object = NULL; + AsmResolverInfo *resInfo; + + if (strncmp(ObjStr(inst->argv[1]), "::nsf::methods::", 16) == 0) { + cmd = Tcl_GetCommandFromObj(interp, inst->argv[1]); + //fprintf(stderr, "%s: asmMethod cmd '%s' => %p\n", procName, ObjStr(inst->argv[1]), cmd); + } + if (strncmp(ObjStr(inst->argv[0]), "::nx::", 6) == 0) { + GetObjectFromObj(interp, inst->argv[0], &object); + //fprintf(stderr, "%s: asmMethod object '%s' => %p\n", procName, ObjStr(inst->argv[0]), object); + } + if (cmd && object) { + // experimental: bind obj and method + resInfo = NEW(AsmResolverInfo); // TODO: LEAK + resInfo->cmd = cmd; + resInfo->object = object; + inst->clientData = resInfo; + AsmInstructionSetCmd(inst, asmMethodDelegateDispatch11); + } else if (cmd) { + inst->clientData = cmd; + } else { + inst->clientData = NULL; + } + } + } \ + -returnsResult true \ + -execCode { + { Tcl_Command cmd = NULL; + NsfObject *object; + + // obj and method are unresolved + result = GetObjectFromObj(interp, ip->argv[0], &object); + if (likely(ip->clientData != NULL)) { + cmd = ip->clientData; + } else { + cmd = Tcl_GetCommandFromObj(interp, ip->argv[1]); + } + //fprintf(stderr, "cmd %p object %p\n", cmd, object); + result = MethodDispatch(object, interp, ip->argc-1, ip->argv+1, cmd, object, NULL, + ObjStr(ip->argv[1]), 0, 0); + } + } + + # methodDelegateDispatch11 is an optimized variant of + # methodDelegateDispatch, emitted alternatively by the assembler for + # the above instruction. + Instruction create methodDelegateDispatch11 \ + -returnsResult true \ + -execCode { + // obj and method are resolved + { + AsmResolverInfo *resInfo = ip->clientData; + result = MethodDispatch(resInfo->object, interp, ip->argc-1, ip->argv+1, + resInfo->cmd, resInfo->object, NULL, + ObjStr(ip->argv[1]), 0, 0); + } + } + + + # {methodSelfDispatch obj 0 obj 1 obj 2} + + Instruction create methodSelfDispatch \ + -minArgs 3 -maxArgs -1 -cArgs NR_PAIRS -argTypes asmStatementCmdType \ + -asmEmitCode { + { Tcl_Command cmd = NULL; + AsmResolverInfo *resInfo; + + if (strncmp(ObjStr(inst->argv[0]), "::nsf::methods::", 16) == 0) { + cmd = Tcl_GetCommandFromObj(interp, inst->argv[0]); + if (cmd) { + //fprintf(stderr, "%s: asmMethodSelfCmdDispatch cmd '%s' => %p\n", procName, ObjStr(inst->argv[0]), cmd); + AsmInstructionSetCmd(inst, asmMethodSelfCmdDispatch); + } + } else { + //fprintf(stderr, "%s: asmMethodSelfDispatch cmd '%s'\n", procName, ObjStr(inst->argv[0])); + } + resInfo = NEW(AsmResolverInfo); // TODO: LEAK + resInfo->cmd = cmd; + resInfo->proc = proc; + inst->clientData = resInfo; + } + } \ + -returnsResult true \ + -execCode { + { + AsmResolverInfo *resInfo = ip->clientData; + Tcl_Command cmd = resInfo->cmd ? resInfo->cmd : Tcl_GetCommandFromObj(interp, ip->argv[0]); + + result = MethodDispatch(resInfo->proc->currentObject, interp, + ip->argc, ip->argv, + cmd, resInfo->proc->currentObject, NULL, + ObjStr(ip->argv[0]), 0, 0); + } + } + + # methodSelfCmdDispatch is an optimized variant of + # methodSelfDispatch, emitted alternatively by the assembler for the + # above instruction. + Instruction create methodSelfCmdDispatch \ + -returnsResult true \ + -execCode { + { + AsmResolverInfo *resInfo = ip->clientData; + assert(resInfo->cmd != NULL); + result = Tcl_NRCallObjProc(interp, Tcl_Command_objProc(resInfo->cmd), resInfo->proc->currentObject, + ip->argc, ip->argv); + } + } + + # {self} + + Instruction create self \ + -minArgs 1 -maxArgs 1 \ + -execNeedsProc true \ + -execCode { + Tcl_SetObjResult(interp, proc->currentObject->cmdName); + } + + + # {jump instruction 2} + # TODO: maybe define later jump labels in asm source + Instruction create jump \ + -minArgs 3 -maxArgs 3 -cArgs 1 -argTypes asmStatementInstructionType \ + -execNeedsProc true \ + -isJump true \ + -execCode { + //fprintf(stderr, "asmJump oc %d instructionIndex %d\n", ip->argc, PTR2INT(ip->argv[0])); + NsfAsmJump(PTR2INT(ip->argv[0])); + } + + # {jumpTrue instruction 6} + # TODO: maybe define later jump labels in asm source + Instruction create jumpTrue \ + -minArgs 3 -maxArgs 3 -cArgs 1 -argTypes asmStatementInstructionType \ + -execNeedsProc true \ + -isJump true \ + -execCode { + if (proc->status) { + //fprintf(stderr, "asmJumpTrue jump oc %d instructionIndex %d\n", ip->argc, PTR2INT(ip->argv[0])); + NsfAsmJump(PTR2INT(ip->argv[0])); + } else { + //fprintf(stderr, "asmJumpTrue fall through\n"); + NsfAsmJumpNext(); + } + } + + # {leIntObj slot 4 slot 7} + + Instruction create leIntObj \ + -minArgs 5 -maxArgs 5 -cArgs 2 -argTypes asmStatementSlotType \ + -execNeedsProc true \ + -execCode { + { + int value1, value2; + Tcl_Obj *obj; + //fprintf(stderr, "leIntObj oc %d op1 %p op2 %p\n", ip->argc, ip->argv[0], ip->argv[1]); + + // for the time being, we compare two int values + obj = proc->slots[PTR2INT(ip->argv[0])]; + if (likely(obj->typePtr == Nsf_OT_intType)) { + value1 = obj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, obj, &value1); + } + obj = proc->slots[PTR2INT(ip->argv[1])]; + if (likely(obj->typePtr == Nsf_OT_intType)) { + value2 = obj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, obj, &value2); + } + //fprintf(stderr, "asmLeScalar oc %d op1 %d op2 %d => %d\n", ip->argc, value1, value2, value1 <= value2); + + proc->status = value1 <= value2; + } + } + + # {leInt slot 4 slot 7} + + Instruction create leInt \ + -minArgs 5 -maxArgs 5 -cArgs 2 -argTypes asmStatementSlotType \ + -execNeedsProc true \ + -execCode { + { + int value1, value2; + value1 = PTR2INT(proc->slots[PTR2INT(ip->argv[0])]); + value2 = PTR2INT(proc->slots[PTR2INT(ip->argv[1])]); + proc->status = value1 <= value2; + } + } + + + # {duplicateObj slot 6 obj 2} + # TODO: should force first arg "slot" + Instruction create duplicateObj \ + -minArgs 5 -maxArgs 5 -cArgs 2 -argTypes asmStatementSlotObjArgType \ + -execNeedsProc true \ + -execCode { + { + int indexValue = PTR2INT(ip->argv[0]); + //fprintf(stderr, "duplicateObj var[%d] = %s\n", indexValue, ObjStr(ip->argv[1])); + if (proc->slots[indexValue]) { + Tcl_DecrRefCount(proc->slots[indexValue]); + } + proc->slots[indexValue] = Tcl_DuplicateObj(ip->argv[1]); + Tcl_IncrRefCount(proc->slots[indexValue]); + proc->slotFlags[indexValue] |= ASM_SLOT_MUST_DECR; + } + } + + + # {setObj slot 2 arg 0} + # TODO: should force first arg "slot" + Instruction create setObj \ + -minArgs 5 -maxArgs 5 -cArgs 2 -argTypes asmStatementSlotObjArgType \ + -execNeedsProc true \ + -execCode { + //fprintf(stderr, "setObj var[%d] = %s\n", PTR2INT(ip->argv[0]), ObjStr(ip->argv[1])); + proc->slots[PTR2INT(ip->argv[0])] = ip->argv[1]; + } + + # {setInt slot 6 int 0} + # TODO: should force first arg "slot" + Instruction create setInt \ + -minArgs 5 -maxArgs 5 -cArgs 2 -argTypes asmStatementSlotIntType \ + -execNeedsProc true \ + -execCode { + proc->slots[PTR2INT(ip->argv[0])] = ip->argv[1]; + } + + # {setObjToResult slot 5} + Instruction create setObjToResult \ + -minArgs 3 -maxArgs 3 -cArgs 2 -argTypes asmStatementSlotType \ + -execNeedsProc true \ + -execCode { + //fprintf(stderr, "setObjToResult var[%d] = %s\n", PTR2INT(ip->argv[0]), ObjStr(ip->argv[1])); + proc->slots[PTR2INT(ip->argv[0])] = Tcl_GetObjResult(interp); + } + + # {setResult slot 6} + Instruction create setResult \ + -minArgs 3 -maxArgs 3 -cArgs 1 -argTypes asmStatementSlotType \ + -execNeedsProc true \ + -execCode { + Tcl_SetObjResult(interp, proc->slots[PTR2INT(ip->argv[0])]); + } + + # {setResultInt slot 6} + Instruction create setResultInt \ + -minArgs 3 -maxArgs 3 -cArgs 1 -argTypes asmStatementSlotType \ + -execNeedsProc true \ + -execCode { + Tcl_SetObjResult(interp, Tcl_NewIntObj(PTR2INT(proc->slots[PTR2INT(ip->argv[0])]))); + } + + # {store code 4 argv 2} + Instruction create storeResult \ + -minArgs 5 -maxArgs 5 -cArgs 0 -argTypes asmStatementStoreType \ + -asmEmitCode { + codeIndex = -1; + argvIndex = -1; + for (j = offset; j < argc; j += 2) { + int argIndex, intValue; + Tcl_GetIndexFromObj(interp, argv[j], asmStatementArgType, "asm internal arg type", 0, &argIndex); + Tcl_GetIntFromObj(interp, argv[j+1], &intValue); + switch (argIndex) { + case asmStatementArgTypeInstructionIdx: codeIndex = intValue; break; + case asmStatementArgTypeArgvIdx: argvIndex = intValue; break; + } + } + // TODO: CHECK codeIndex, argvIndex (>0, reasonable values) + //fprintf(stderr, "%p setting instruction %d => %d %d\n", patches, currentAsmInstruction, codeIndex, argvIndex); + patches->targetAsmInstruction = currentAsmInstruction; + patches->sourceAsmInstruction = codeIndex; + patches->argvIndex = argvIndex; + patches++; + } -execCode { + ip->argv[0] = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(ip->argv[0]); + } + + # {incrObj slot 6 slot 7} + Instruction create incrObj \ + -minArgs 5 -maxArgs 5 -cArgs 2 -argTypes asmStatementSlotType \ + -execNeedsProc true \ + -execCode { + { + int intValue, incrValue; + Tcl_Obj *intObj, *incrObj; + + //fprintf(stderr, "asmIncrScalar var[%d] incr var[%d], ", PTR2INT(ip->argv[0]), PTR2INT(ip->argv[1])); + + intObj = proc->slots[PTR2INT(ip->argv[0])]; + incrObj = proc->slots[PTR2INT(ip->argv[1])]; + + if (likely(intObj->typePtr == Nsf_OT_intType)) { + intValue = intObj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, intObj, &intValue); + } + + if (likely(incrObj->typePtr == Nsf_OT_intType)) { + incrValue = incrObj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, incrObj, &incrValue); + } + + //fprintf(stderr, "%d + %d = %d,", intValue, incrValue, intValue + incrValue); + + Tcl_InvalidateStringRep(intObj); + intObj->internalRep.longValue = (long)(intValue + incrValue); + + //fprintf(stderr, "updated %p var[%d] %p\n", intObj, PTR2INT(ip->argv[0]), proc->slots[PTR2INT(ip->argv[0])]); + + //Tcl_SetObjResult(interp, intObj); + } + } + + # {incrInt slot 6 slot 7} + Instruction create incrInt \ + -minArgs 5 -maxArgs 5 -cArgs 2 -argTypes asmStatementSlotType \ + -execNeedsProc true \ + -execCode { + { + int intValue, incrValue; + //fprintf(stderr, "incrInt var[%d] incr var[%d]\n", PTR2INT(ip->argv[0]), PTR2INT(ip->argv[1])); + intValue = PTR2INT(proc->slots[PTR2INT(ip->argv[0])]); + incrValue = PTR2INT(proc->slots[PTR2INT(ip->argv[1])]); + //fprintf(stderr, ".... intValue %d incr Value %d\n", intValue, incrValue); + + proc->slots[PTR2INT(ip->argv[0])] = INT2PTR(intValue + incrValue); + //fprintf(stderr, ".... [%d] => %d\n", PTR2INT(ip->argv[0]), intValue + incrValue); + } + } + +} + +###################################################################### +# generate the code +###################################################################### + +generate ::LabelThreading +generate ::CallThreading \ No newline at end of file Index: generic/asm/nsfAsmAssemble.c =================================================================== diff -u --- generic/asm/nsfAsmAssemble.c (revision 0) +++ generic/asm/nsfAsmAssemble.c (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,580 @@ +enum asmStatementIndex { + asmObjProcIdx, + asmEvalIdx, + asmDuplicateObjIdx, + asmIncrIntIdx, + asmIncrObjIdx, + asmIntegerIdx, + asmJumpIdx, + asmJumpTrueIdx, + asmLeIntIdx, + asmLeIntObjIdx, + asmMethodDelegateDispatchIdx, + asmMethodSelfDispatchIdx, + asmNoopIdx, + asmObjIdx, + asmSelfIdx, + asmSetIntIdx, + asmSetObjIdx, + asmSetObjToResultIdx, + asmSetResultIdx, + asmSetResultIntIdx, + asmStoreResultIdx, + asmVarIdx +}; + +static CONST char *asmStatementNames[] = { + "cmd", + "eval", + "duplicateObj", + "incrInt", + "incrObj", + "integer", + "jump", + "jumpTrue", + "leInt", + "leIntObj", + "methodDelegateDispatch", + "methodSelfDispatch", + "noop", + "obj", + "self", + "setInt", + "setObj", + "setObjToResult", + "setResult", + "setResultInt", + "storeResult", + "var", + NULL +}; + +enum asmStatmentArgTypeIndex { + asmStatementArgTypeArgIdx, + asmStatementArgTypeArgvIdx, + asmStatementArgTypeInstructionIdx, + asmStatementArgTypeIntIdx, + asmStatementArgTypeObjIdx, + asmStatementArgTypeResultIdx, + asmStatementArgTypeSlotIdx, + asmStatementArgTypeVarIdx +}; + +static CONST char *asmStatementArgType[] = { + "arg", + "argv", + "instruction", + "int", + "obj", + "result", + "slot", + "var", + NULL}; + +static CONST char *asmStatementCmdType[] = {"arg", "obj", "result", "var", NULL}; +static CONST char *asmStatementInstructionType[] = {"instruction", NULL}; +static CONST char *asmStatementIntType[] = {"int", NULL}; +static CONST char *asmStatementObjType[] = {"obj", NULL}; +static CONST char *asmStatementSlotObjArgType[] = {"slot", "obj", "arg", NULL}; +static CONST char *asmStatementSlotType[] = {"slot", NULL}; +static CONST char *asmStatementSlotIntType[] = {"slot", "int", NULL}; +static CONST char *asmStatementStoreType[] = {"instruction", "argv", NULL}; + +static AsmStatementInfo asmStatementInfo[] = { + /* asmObjProcIdx, */ + {ASM_INFO_PAIRS|ASM_INFO_SKIP1, NULL, 2, -1, NR_PAIRS1}, + /* asmEval */ + {0|ASM_INFO_PAIRS, asmStatementCmdType, 3, -1, NR_PAIRS}, + /* asmDuplicateObj */ + {0|ASM_INFO_PAIRS, asmStatementSlotObjArgType, 5, 5, 2}, + /* asmIncrInt */ + {0|ASM_INFO_PAIRS, asmStatementSlotType, 5, 5, 2}, + /* asmIncrObj */ + {0|ASM_INFO_PAIRS, asmStatementSlotType, 5, 5, 2}, + /* asmInteger */ + {0|ASM_INFO_DECL|ASM_INFO_PAIRS, asmStatementIntType, 3, 3, 0}, + /* asmJump */ + {0|ASM_INFO_PAIRS, asmStatementInstructionType, 3, 3, 1}, + /* asmJumpTrue */ + {0|ASM_INFO_PAIRS, asmStatementInstructionType, 3, 3, 1}, + /* asmLeInt */ + {0|ASM_INFO_PAIRS, asmStatementSlotType, 5, 5, 2}, + /* asmLeIntObj */ + {0|ASM_INFO_PAIRS, asmStatementSlotType, 5, 5, 2}, + /* asmMethodDelegateDispatch */ + {0|ASM_INFO_PAIRS, asmStatementCmdType, 5, -1, NR_PAIRS}, + /* asmMethodSelfDispatch */ + {0|ASM_INFO_PAIRS, asmStatementCmdType, 3, -1, NR_PAIRS}, + /* asmNoop */ + {0, NULL, 1, 1, 0}, + /* asmObj */ + {0|ASM_INFO_DECL, NULL, 2, 2, 0}, + /* asmSelf */ + {0|ASM_INFO_PAIRS, NULL, 1, 1, 0}, + /* asmSetInt */ + {0|ASM_INFO_PAIRS, asmStatementSlotIntType, 5, 5, 2}, + /* asmSetObj */ + {0|ASM_INFO_PAIRS, asmStatementSlotObjArgType, 5, 5, 2}, + /* asmSetObjToResult */ + {0|ASM_INFO_PAIRS, asmStatementSlotType, 3, 3, 2}, + /* asmSetResult */ + {0|ASM_INFO_PAIRS, asmStatementSlotType, 3, 3, 1}, + /* asmSetResultInt */ + {0|ASM_INFO_PAIRS, asmStatementSlotType, 3, 3, 1}, + /* asmStoreResult */ + {0|ASM_INFO_PAIRS, asmStatementStoreType, 5, 5, 0}, + /* asmVar */ + {0|ASM_INFO_DECL|ASM_INFO_PAIRS, asmStatementObjType, 3, 3, 0} +}; + + +/* + *---------------------------------------------------------------------- + * AsmAssemble -- + * + * The assmbler, takes an assembly script in the form of a nested + * list and emits the internal representation for the execution + * enigine. + * + *---------------------------------------------------------------------- + */ + +static int +AsmAssemble(ClientData cd, Tcl_Interp *interp, Tcl_Obj *nameObj, + int nrArgs, Tcl_Obj *asmObj, AsmCompiledProc **retAsmProc) { + AsmPatches patchArray[100], *patches = &patchArray[0], *patchPtr; // TODO: make me dynamic + Tcl_Command cmd; + AsmCompiledProc *proc; + AsmInstruction *inst; + int i, result, nrAsmInstructions, nrLocalObjs, totalArgvArgs; + int oc, currentAsmInstruction, currentSlot; + Tcl_Obj **ov; + CONST char *procName; + + assert(nameObj); + procName = ObjStr(nameObj); + + if (Tcl_ListObjGetElements(interp, asmObj, &oc, &ov) != TCL_OK) { + return NsfPrintError(interp, "Asm code is not a valid list"); + } + + /* + * First Iteration: check wellformedness, determine sizes + */ + nrAsmInstructions = 0; + nrLocalObjs = 0; + totalArgvArgs = 0; + + for (i = 0; i < oc; i++) { + int index, offset, wordOc; + Tcl_Obj *lineObj = ov[i], **wordOv; + + if (Tcl_ListObjGetElements(interp, lineObj, &wordOc, &wordOv) != TCL_OK) { + return NsfPrintError(interp, + "Asm: line is not a well-formed asm instruction: %s", + ObjStr(lineObj)); + } + + result = Tcl_GetIndexFromObj(interp, wordOv[0], asmStatementNames, "asm instruction", 0, &index); + if (result != TCL_OK) { + return NsfPrintError(interp, + "Asm: line is not a valid asm instruction: word %s, line %s", + ObjStr(wordOv[0]), ObjStr(lineObj)); + } + + offset = (asmStatementInfo[index].flags & ASM_INFO_SKIP1) ? 2 : 1; + + if ((asmStatementInfo[index].flags & ASM_INFO_PAIRS) && (wordOc-offset) % 2 == 1) { + return NsfPrintError(interp, "Asm: argument list of cmd must contain pairs: %s", + ObjStr(lineObj)); + } + + if (asmStatementInfo[index].minArgs > -1 + && wordOc < asmStatementInfo[index].minArgs) { + return NsfPrintError(interp, "Asm: statement must contain at least %d words: %s", + asmStatementInfo[index].minArgs, ObjStr(lineObj)); + } + + if (asmStatementInfo[index].maxArgs > -1 + && wordOc > asmStatementInfo[index].maxArgs) { + return NsfPrintError(interp, "Asm: statement must contain at most %d words: %s", + asmStatementInfo[index].maxArgs, ObjStr(lineObj)); + } + + if (asmStatementInfo[index].argTypes) { + result = AsmInstructionArgvCheck(interp, offset, wordOc, + asmStatementInfo[index].argTypes, + nrLocalObjs, oc, wordOv, lineObj); + if (unlikely(result != TCL_OK)) {return result;} + } + + if ((asmStatementInfo[index].flags & ASM_INFO_DECL) == 0) { + int cArgs = asmStatementInfo[index].cArgs; + /* + * Determine the actual number of arguments passed to the + * emitted instruction. This number might be determine by the + * instruction type, or by the actual instruction being + * processed (and later maybe for {*} etc.). + */ + if (cArgs == NR_PAIRS) { + cArgs = (wordOc-offset) / 2; + } else if (cArgs == NR_PAIRS1) { + cArgs = 1 + (wordOc-offset) / 2; + } + //fprintf(stderr, "instruction %s need argvargs %d\n", ObjStr(lineObj), cArgs); + totalArgvArgs += cArgs; + + nrAsmInstructions++; + } else { + /* currently obj and var from the same pool, will change... */ + nrLocalObjs ++; + } + + /* + * optional, per-statement check operations + */ + switch (index) { + case asmObjProcIdx: + /* {cmd ::set slot 0 slot 2} */ + cmd = Tcl_GetCommandFromObj(interp, wordOv[1]); + if (cmd == NULL) { + return NsfPrintError(interp, + "Asm: cmd is not a valid tcl command: %s\n", + Tcl_GetString( wordOv[1])); + } + break; + + /* begin generated code */ + + /* end generated code */ + + default: + break; + } + } + + nrAsmInstructions ++; + fprintf(stderr, "%s: nrAsmInstructions %d nrLocalObjs %d nrArgs %d argvArgs %d => data %d\n", + procName, nrAsmInstructions, nrLocalObjs, nrArgs, totalArgvArgs, + nrLocalObjs + nrArgs + totalArgvArgs ); + + /* + * Allocate structures + */ + + proc = (AsmCompiledProc *)ckalloc(sizeof(AsmCompiledProc)); + proc->code = (AsmInstruction *)ckalloc(sizeof(AsmInstruction) * nrAsmInstructions); + memset(proc->slotFlags, 0, sizeof(int) * NSF_ASM_NR_STATIC_SLOTS); + + proc->ip = proc->code; /* points to the first writable instructon */ + proc->firstObj = proc->staticObjs; /* point to the first free obj */ + proc->locals = proc->staticObjs; /* locals is just an alias */ + proc->nrAsmArgReferences = 0; + proc->slots = proc->locals + nrArgs; + //fprintf(stderr, "args = %ld\n", proc->slots - proc->locals); + + AsmLocalsAlloc(proc, nrArgs + nrLocalObjs); + /* when freeing, we need something like + for (i=0; i < nrArgs + nrLocalObjs; i++) { + if (proc->slotFlags[i] & ASM_SLOT_MUST_DECR) {Tcl_DecrRefCount(proc->slots[i]); } + } + */ + + /* + * Second Iteration: emit code + */ + currentSlot = 0; + currentAsmInstruction = 0; + + for (i = 0; i < oc; i++) { + int index, offset, cArgs, argc, codeIndex, argvIndex, j; + Tcl_Obj *lineObj = ov[i], **argv; + + Tcl_ListObjGetElements(interp, lineObj, &argc, &argv); + Tcl_GetIndexFromObj(interp, argv[0], asmStatementNames, "asm instruction", 0, &index); + + offset = (asmStatementInfo[index].flags & ASM_INFO_SKIP1) ? 2 : 1; + + cArgs = asmStatementInfo[index].cArgs; + if (cArgs == NR_PAIRS) { + cArgs = (argc-offset) / 2; + } else if (cArgs == NR_PAIRS1) { + cArgs = 1 + (argc-offset) / 2; + } + + switch (index) { + + case asmObjProcIdx: + /* {cmd ::set slot 0 slot 2} */ + cmd = Tcl_GetCommandFromObj(interp, argv[1]); +#if defined(LABEL_THREADING) + inst = AsmInstructionNew(proc, objProc, cArgs); + inst->cmd = ((Command *)cmd)->objProc; +#else + inst = AsmInstructionNew(proc, ((Command *)cmd)->objProc, cArgs); +#endif + inst->clientData = ((Command *)cmd)->objClientData; + /* use the assembly word as cmd name; should be ok when we keep assembly around */ + inst->argv[0] = argv[1]; + /*fprintf(stderr, "[%d] %s/%d\n", currentAsmInstruction, Tcl_GetString(argv[1]), 1+((argc-offset)/2));*/ + + AsmInstructionArgvSet(interp, offset, argc, 1, inst, proc, argv, 0); + break; + + /* begin generated code */ + case asmEvalIdx: + + inst = AsmInstructionNew(proc, asmEval, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + break; + + case asmDuplicateObjIdx: + + inst = AsmInstructionNew(proc, asmDuplicateObj, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmIncrIntIdx: + + inst = AsmInstructionNew(proc, asmIncrInt, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmIncrObjIdx: + + inst = AsmInstructionNew(proc, asmIncrObj, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmIntegerIdx: + + { + int intValue; + Tcl_GetIntFromObj(interp, argv[2], &intValue); + proc->slots[currentSlot] = INT2PTR(intValue); + //fprintf(stderr, "setting slots [%d] = %d\n", currentSlot, intValue); + proc->slotFlags[currentSlot] |= ASM_SLOT_IS_INTEGER; + currentSlot ++; + } + + break; + + case asmJumpIdx: + + inst = AsmInstructionNew(proc, asmJump, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmJumpTrueIdx: + + inst = AsmInstructionNew(proc, asmJumpTrue, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmLeIntIdx: + + inst = AsmInstructionNew(proc, asmLeInt, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmLeIntObjIdx: + + inst = AsmInstructionNew(proc, asmLeIntObj, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmMethodDelegateDispatchIdx: + + inst = AsmInstructionNew(proc, asmMethodDelegateDispatch, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + { Tcl_Command cmd = NULL; + NsfObject *object = NULL; + AsmResolverInfo *resInfo; + + if (strncmp(ObjStr(inst->argv[1]), "::nsf::methods::", 16) == 0) { + cmd = Tcl_GetCommandFromObj(interp, inst->argv[1]); + //fprintf(stderr, "%s: asmMethod cmd '%s' => %p\n", procName, ObjStr(inst->argv[1]), cmd); + } + if (strncmp(ObjStr(inst->argv[0]), "::nx::", 6) == 0) { + GetObjectFromObj(interp, inst->argv[0], &object); + //fprintf(stderr, "%s: asmMethod object '%s' => %p\n", procName, ObjStr(inst->argv[0]), object); + } + if (cmd && object) { + // experimental: bind obj and method + resInfo = NEW(AsmResolverInfo); // TODO: LEAK + resInfo->cmd = cmd; + resInfo->object = object; + inst->clientData = resInfo; + AsmInstructionSetCmd(inst, asmMethodDelegateDispatch11); + } else if (cmd) { + inst->clientData = cmd; + } else { + inst->clientData = NULL; + } + } + + break; + + case asmMethodSelfDispatchIdx: + + inst = AsmInstructionNew(proc, asmMethodSelfDispatch, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + { Tcl_Command cmd = NULL; + AsmResolverInfo *resInfo; + + if (strncmp(ObjStr(inst->argv[0]), "::nsf::methods::", 16) == 0) { + cmd = Tcl_GetCommandFromObj(interp, inst->argv[0]); + if (cmd) { + //fprintf(stderr, "%s: asmMethodSelfCmdDispatch cmd '%s' => %p\n", procName, ObjStr(inst->argv[0]), cmd); + AsmInstructionSetCmd(inst, asmMethodSelfCmdDispatch); + } + } else { + //fprintf(stderr, "%s: asmMethodSelfDispatch cmd '%s'\n", procName, ObjStr(inst->argv[0])); + } + resInfo = NEW(AsmResolverInfo); // TODO: LEAK + resInfo->cmd = cmd; + resInfo->proc = proc; + inst->clientData = resInfo; + } + + break; + + case asmNoopIdx: + + inst = AsmInstructionNew(proc, asmNoop, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + break; + + case asmObjIdx: + + proc->slots[currentSlot] = argv[1]; + Tcl_IncrRefCount(proc->slots[currentSlot]); + proc->slotFlags[currentSlot] |= ASM_SLOT_MUST_DECR; + currentSlot ++; + + break; + + case asmSelfIdx: + + inst = AsmInstructionNew(proc, asmSelf, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmSetIntIdx: + + inst = AsmInstructionNew(proc, asmSetInt, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmSetObjIdx: + + inst = AsmInstructionNew(proc, asmSetObj, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmSetObjToResultIdx: + + inst = AsmInstructionNew(proc, asmSetObjToResult, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmSetResultIdx: + + inst = AsmInstructionNew(proc, asmSetResult, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmSetResultIntIdx: + + inst = AsmInstructionNew(proc, asmSetResultInt, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + inst->clientData = proc; + + break; + + case asmStoreResultIdx: + + inst = AsmInstructionNew(proc, asmStoreResult, cArgs); + if (cArgs>0) {AsmInstructionArgvSet(interp, offset, argc, 0, inst, proc, argv, 0);} + codeIndex = -1; + argvIndex = -1; + for (j = offset; j < argc; j += 2) { + int argIndex, intValue; + Tcl_GetIndexFromObj(interp, argv[j], asmStatementArgType, "asm internal arg type", 0, &argIndex); + Tcl_GetIntFromObj(interp, argv[j+1], &intValue); + switch (argIndex) { + case asmStatementArgTypeInstructionIdx: codeIndex = intValue; break; + case asmStatementArgTypeArgvIdx: argvIndex = intValue; break; + } + } + // TODO: CHECK codeIndex, argvIndex (>0, reasonable values) + //fprintf(stderr, "%p setting instruction %d => %d %d\n", patches, currentAsmInstruction, codeIndex, argvIndex); + patches->targetAsmInstruction = currentAsmInstruction; + patches->sourceAsmInstruction = codeIndex; + patches->argvIndex = argvIndex; + patches++; + + break; + + case asmVarIdx: + + proc->slots[currentSlot] = NULL; + currentSlot ++; + + break; + + + /* end generated code */ + } + + if ((asmStatementInfo[index].flags & ASM_INFO_DECL) == 0) { + currentAsmInstruction ++; + } + } + + /* + * add END instruction + */ + inst = AsmInstructionNew(proc, NULL, 0); + + /* + * All addresses are determined, apply the argv patches triggered + * from above. + */ + + for (patchPtr = &patchArray[0]; patchPtr < patches; patchPtr++) { + fprintf(stderr, "wanna patch code[%d]->argv = code[%d]->argv[%d]\n", + patchPtr->targetAsmInstruction, patchPtr->sourceAsmInstruction, patchPtr->argvIndex); + /* set the argument vector of code[1] to the address of code[4]->argv[1] */ + (&proc->code[patchPtr->targetAsmInstruction])->argv = + &(&proc->code[patchPtr->sourceAsmInstruction])->argv[patchPtr->argvIndex]; + } + + *retAsmProc = proc; + + return TCL_OK; +} Index: generic/asm/nsfAsmExecuteCallThreading.c =================================================================== diff -u --- generic/asm/nsfAsmExecuteCallThreading.c (revision 0) +++ generic/asm/nsfAsmExecuteCallThreading.c (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,313 @@ + +static int asmEval(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + int result; + + result = Tcl_EvalObjv(interp, argc, argv, 0); + return result; +} + +static int asmDuplicateObj(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + { + int indexValue = PTR2INT(argv[0]); + //fprintf(stderr, "duplicateObj var[%d] = %s\n", indexValue, ObjStr(argv[1])); + if (proc->slots[indexValue]) { + Tcl_DecrRefCount(proc->slots[indexValue]); + } + proc->slots[indexValue] = Tcl_DuplicateObj(argv[1]); + Tcl_IncrRefCount(proc->slots[indexValue]); + proc->slotFlags[indexValue] |= ASM_SLOT_MUST_DECR; + } + return TCL_OK; +} + +static int asmIncrInt(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + { + int intValue, incrValue; + //fprintf(stderr, "incrInt var[%d] incr var[%d]\n", PTR2INT(argv[0]), PTR2INT(argv[1])); + intValue = PTR2INT(proc->slots[PTR2INT(argv[0])]); + incrValue = PTR2INT(proc->slots[PTR2INT(argv[1])]); + //fprintf(stderr, ".... intValue %d incr Value %d\n", intValue, incrValue); + + proc->slots[PTR2INT(argv[0])] = INT2PTR(intValue + incrValue); + //fprintf(stderr, ".... [%d] => %d\n", PTR2INT(argv[0]), intValue + incrValue); + } + return TCL_OK; +} + +static int asmIncrObj(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + { + int intValue, incrValue; + Tcl_Obj *intObj, *incrObj; + + //fprintf(stderr, "asmIncrScalar var[%d] incr var[%d], ", PTR2INT(argv[0]), PTR2INT(argv[1])); + + intObj = proc->slots[PTR2INT(argv[0])]; + incrObj = proc->slots[PTR2INT(argv[1])]; + + if (likely(intObj->typePtr == Nsf_OT_intType)) { + intValue = intObj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, intObj, &intValue); + } + + if (likely(incrObj->typePtr == Nsf_OT_intType)) { + incrValue = incrObj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, incrObj, &incrValue); + } + + //fprintf(stderr, "%d + %d = %d,", intValue, incrValue, intValue + incrValue); + + Tcl_InvalidateStringRep(intObj); + intObj->internalRep.longValue = (long)(intValue + incrValue); + + //fprintf(stderr, "updated %p var[%d] %p\n", intObj, PTR2INT(argv[0]), proc->slots[PTR2INT(argv[0])]); + + //Tcl_SetObjResult(interp, intObj); + } + return TCL_OK; +} + +static int asmJump(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + //fprintf(stderr, "asmJump oc %d instructionIndex %d\n", argc, PTR2INT(argv[0])); + NsfAsmJump(PTR2INT(argv[0])); + return TCL_OK; +} + +static int asmJumpTrue(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + if (proc->status) { + //fprintf(stderr, "asmJumpTrue jump oc %d instructionIndex %d\n", argc, PTR2INT(argv[0])); + NsfAsmJump(PTR2INT(argv[0])); + } else { + //fprintf(stderr, "asmJumpTrue fall through\n"); + NsfAsmJumpNext(); + } + return TCL_OK; +} + +static int asmLeInt(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + { + int value1, value2; + value1 = PTR2INT(proc->slots[PTR2INT(argv[0])]); + value2 = PTR2INT(proc->slots[PTR2INT(argv[1])]); + proc->status = value1 <= value2; + } + return TCL_OK; +} + +static int asmLeIntObj(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + { + int value1, value2; + Tcl_Obj *obj; + //fprintf(stderr, "leIntObj oc %d op1 %p op2 %p\n", argc, argv[0], argv[1]); + + // for the time being, we compare two int values + obj = proc->slots[PTR2INT(argv[0])]; + if (likely(obj->typePtr == Nsf_OT_intType)) { + value1 = obj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, obj, &value1); + } + obj = proc->slots[PTR2INT(argv[1])]; + if (likely(obj->typePtr == Nsf_OT_intType)) { + value2 = obj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, obj, &value2); + } + //fprintf(stderr, "asmLeScalar oc %d op1 %d op2 %d => %d\n", argc, value1, value2, value1 <= value2); + + proc->status = value1 <= value2; + } + return TCL_OK; +} + +static int asmMethodDelegateDispatch(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + int result; + + { Tcl_Command cmd = NULL; + NsfObject *object; + + // obj and method are unresolved + result = GetObjectFromObj(interp, argv[0], &object); + if (likely(clientData != NULL)) { + cmd = clientData; + } else { + cmd = Tcl_GetCommandFromObj(interp, argv[1]); + } + //fprintf(stderr, "cmd %p object %p\n", cmd, object); + result = MethodDispatch(object, interp, argc-1, argv+1, cmd, object, NULL, + ObjStr(argv[1]), 0, 0); + } + return result; +} + +static int asmMethodDelegateDispatch11(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + int result; + + // obj and method are resolved + { + AsmResolverInfo *resInfo = clientData; + result = MethodDispatch(resInfo->object, interp, argc-1, argv+1, + resInfo->cmd, resInfo->object, NULL, + ObjStr(argv[1]), 0, 0); + } + return result; +} + +static int asmMethodSelfCmdDispatch(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + int result; + + { + AsmResolverInfo *resInfo = clientData; + assert(resInfo->cmd != NULL); + result = Tcl_NRCallObjProc(interp, Tcl_Command_objProc(resInfo->cmd), resInfo->proc->currentObject, + argc, argv); + } + return result; +} + +static int asmMethodSelfDispatch(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + int result; + + { + AsmResolverInfo *resInfo = clientData; + Tcl_Command cmd = resInfo->cmd ? resInfo->cmd : Tcl_GetCommandFromObj(interp, argv[0]); + + result = MethodDispatch(resInfo->proc->currentObject, interp, + argc, argv, + cmd, resInfo->proc->currentObject, NULL, + ObjStr(argv[0]), 0, 0); + } + return result; +} + +static int asmNoop(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + return TCL_OK; +} + +static int asmSelf(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + Tcl_SetObjResult(interp, proc->currentObject->cmdName); + return TCL_OK; +} + +static int asmSetInt(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + proc->slots[PTR2INT(argv[0])] = argv[1]; + return TCL_OK; +} + +static int asmSetObj(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + //fprintf(stderr, "setObj var[%d] = %s\n", PTR2INT(argv[0]), ObjStr(argv[1])); + proc->slots[PTR2INT(argv[0])] = argv[1]; + return TCL_OK; +} + +static int asmSetObjToResult(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + //fprintf(stderr, "setObjToResult var[%d] = %s\n", PTR2INT(argv[0]), ObjStr(argv[1])); + proc->slots[PTR2INT(argv[0])] = Tcl_GetObjResult(interp); + return TCL_OK; +} + +static int asmSetResult(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + Tcl_SetObjResult(interp, proc->slots[PTR2INT(argv[0])]); + return TCL_OK; +} + +static int asmSetResultInt(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + AsmCompiledProc *proc = clientData; + + Tcl_SetObjResult(interp, Tcl_NewIntObj(PTR2INT(proc->slots[PTR2INT(argv[0])]))); + return TCL_OK; +} + +static int asmStoreResult(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *argv[]) { + + argv[0] = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(argv[0]); + return TCL_OK; +} + +; + +/* + *---------------------------------------------------------------------- + * AsmExecute -- + * + * Define the execution engine for the code + * + *---------------------------------------------------------------------- + */ +static int +AsmExecute(ClientData cd, Tcl_Interp *interp, AsmCompiledProc *proc, int argc, Tcl_Obj *CONST argv[]) { + //AsmInstruction *ip; + int i, result; + +#if 0 + Var *compiledLocals; + + compiledLocals = ((Interp *) interp)->varFramePtr->compiledLocals; + if (compiledLocals) { + fprintf(stderr, "compiledLocals = %p\n", compiledLocals); + } +#endif + + /* + * Place a copy of the actual argument into locals. + */ + for (i=1; i < argc; i++) { + proc->locals[i-1] = argv[i]; + } + /* + * Update all references to compiled arguments. + */ + for (i=0; i < proc->nrAsmArgReferences; i++) { + AsmArgReference *arPtr = &proc->argReferences[i]; + *(arPtr->objPtr) = proc->locals[arPtr->argNr]; + } + + /* + * Set the instruction pointer to the begin of the code. + */ + proc->ip = proc->code; + //fprintf(stderr, "ip %p\n", proc->ip); + + while (*proc->ip->cmd) { + //fprintf(stderr, "will execute instruction ip %p cmd %p %p/%d\n", ip, ip->cmd, ip->argv[0], ip->argc); + //if (ip->cmd == tclFormat) {AsmInstructionPrint(ip);} + //if (ip->cmd == (Tcl_ObjCmdProc*)tclDispatch) {AsmInstructionPrint(ip);} + result = (*proc->ip->cmd)(proc->ip->clientData, interp, proc->ip->argc, proc->ip->argv); + /*fprintf(stderr, "%s returned <%s> (%d)\n", + Tcl_GetString(ip->argv[0]), + Tcl_GetString(Tcl_GetObjResult(interp)), result);*/ + if (unlikely(result != TCL_OK)) break; + proc->ip++; + //fprintf(stderr, "ip %p\n", proc->ip); + } + + return result; +} + + Index: generic/asm/nsfAsmExecuteLabelThreading.c =================================================================== diff -u --- generic/asm/nsfAsmExecuteLabelThreading.c (revision 0) +++ generic/asm/nsfAsmExecuteLabelThreading.c (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -0,0 +1,362 @@ + +enum instructionIdx { + IDX_objProc, + IDX_asmEval, + IDX_asmDuplicateObj, + IDX_asmIncrInt, + IDX_asmIncrObj, + IDX_asmJump, + IDX_asmJumpTrue, + IDX_asmLeInt, + IDX_asmLeIntObj, + IDX_asmMethodDelegateDispatch, + IDX_asmMethodDelegateDispatch11, + IDX_asmMethodSelfCmdDispatch, + IDX_asmMethodSelfDispatch, + IDX_asmNoop, + IDX_asmSelf, + IDX_asmSetInt, + IDX_asmSetObj, + IDX_asmSetObjToResult, + IDX_asmSetResult, + IDX_asmSetResultInt, + IDX_asmStoreResult, + IDX_NULL +}; + +/* + *---------------------------------------------------------------------- + * AsmExecute -- + * + * Define the execution engine for the code + * + *---------------------------------------------------------------------- + */ +int AsmExecute(ClientData cd, Tcl_Interp *interp, AsmCompiledProc *proc, int argc, Tcl_Obj *CONST argv[]) { + int i, result; + AsmInstruction *ip; + + static void *instructionLabel[] = { + &&INST_objProc, + &&INST_asmEval, + &&INST_asmDuplicateObj, + &&INST_asmIncrInt, + &&INST_asmIncrObj, + &&INST_asmJump, + &&INST_asmJumpTrue, + &&INST_asmLeInt, + &&INST_asmLeIntObj, + &&INST_asmMethodDelegateDispatch, + &&INST_asmMethodDelegateDispatch11, + &&INST_asmMethodSelfCmdDispatch, + &&INST_asmMethodSelfDispatch, + &&INST_asmNoop, + &&INST_asmSelf, + &&INST_asmSetInt, + &&INST_asmSetObj, + &&INST_asmSetObjToResult, + &&INST_asmSetResult, + &&INST_asmSetResultInt, + &&INST_asmStoreResult, + &&INST_NULL + }; + + + /* + * Place a copy of the actual argument into locals. + */ + for (i=1; i < argc; i++) { + proc->locals[i-1] = argv[i]; + } + /* + * Update all references to compiled arguments. + */ + for (i=0; i < proc->nrAsmArgReferences; i++) { + AsmArgReference *arPtr = &proc->argReferences[i]; + *(arPtr->objPtr) = proc->locals[arPtr->argNr]; + } + + /* + * Set the instruction pointer to the begin of the code. + */ + ip = proc->code; + proc->status = 0; + + //fprintf(stderr, "AsmExecute jumps to %p\n", ip); + + goto *instructionLabel[ip->labelIdx]; + + INST_NULL: + return result; + + EXEC_RESULT_CODE_HANDLER: + if (likely(result == TCL_OK)) { + ip++; + goto *instructionLabel[ip->labelIdx]; + } else { + return result; + } + + INST_objProc: + result = (*ip->cmd)(ip->clientData, interp, ip->argc, ip->argv); + goto EXEC_RESULT_CODE_HANDLER; + + INST_asmEval: + + result = Tcl_EvalObjv(interp, ip->argc, ip->argv, 0); + goto EXEC_RESULT_CODE_HANDLER; + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmDuplicateObj: + + { + int indexValue = PTR2INT(ip->argv[0]); + //fprintf(stderr, "duplicateObj var[%d] = %s\n", indexValue, ObjStr(ip->argv[1])); + if (proc->slots[indexValue]) { + Tcl_DecrRefCount(proc->slots[indexValue]); + } + proc->slots[indexValue] = Tcl_DuplicateObj(ip->argv[1]); + Tcl_IncrRefCount(proc->slots[indexValue]); + proc->slotFlags[indexValue] |= ASM_SLOT_MUST_DECR; + } + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmIncrInt: + + { + int intValue, incrValue; + //fprintf(stderr, "incrInt var[%d] incr var[%d]\n", PTR2INT(ip->argv[0]), PTR2INT(ip->argv[1])); + intValue = PTR2INT(proc->slots[PTR2INT(ip->argv[0])]); + incrValue = PTR2INT(proc->slots[PTR2INT(ip->argv[1])]); + //fprintf(stderr, ".... intValue %d incr Value %d\n", intValue, incrValue); + + proc->slots[PTR2INT(ip->argv[0])] = INT2PTR(intValue + incrValue); + //fprintf(stderr, ".... [%d] => %d\n", PTR2INT(ip->argv[0]), intValue + incrValue); + } + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmIncrObj: + + { + int intValue, incrValue; + Tcl_Obj *intObj, *incrObj; + + //fprintf(stderr, "asmIncrScalar var[%d] incr var[%d], ", PTR2INT(ip->argv[0]), PTR2INT(ip->argv[1])); + + intObj = proc->slots[PTR2INT(ip->argv[0])]; + incrObj = proc->slots[PTR2INT(ip->argv[1])]; + + if (likely(intObj->typePtr == Nsf_OT_intType)) { + intValue = intObj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, intObj, &intValue); + } + + if (likely(incrObj->typePtr == Nsf_OT_intType)) { + incrValue = incrObj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, incrObj, &incrValue); + } + + //fprintf(stderr, "%d + %d = %d,", intValue, incrValue, intValue + incrValue); + + Tcl_InvalidateStringRep(intObj); + intObj->internalRep.longValue = (long)(intValue + incrValue); + + //fprintf(stderr, "updated %p var[%d] %p\n", intObj, PTR2INT(ip->argv[0]), proc->slots[PTR2INT(ip->argv[0])]); + + //Tcl_SetObjResult(interp, intObj); + } + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmJump: + + //fprintf(stderr, "asmJump oc %d instructionIndex %d\n", ip->argc, PTR2INT(ip->argv[0])); + NsfAsmJump(PTR2INT(ip->argv[0])); + + goto *instructionLabel[ip->labelIdx]; + +INST_asmJumpTrue: + + if (proc->status) { + //fprintf(stderr, "asmJumpTrue jump oc %d instructionIndex %d\n", ip->argc, PTR2INT(ip->argv[0])); + NsfAsmJump(PTR2INT(ip->argv[0])); + } else { + //fprintf(stderr, "asmJumpTrue fall through\n"); + NsfAsmJumpNext(); + } + + goto *instructionLabel[ip->labelIdx]; + +INST_asmLeInt: + + { + int value1, value2; + value1 = PTR2INT(proc->slots[PTR2INT(ip->argv[0])]); + value2 = PTR2INT(proc->slots[PTR2INT(ip->argv[1])]); + proc->status = value1 <= value2; + } + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmLeIntObj: + + { + int value1, value2; + Tcl_Obj *obj; + //fprintf(stderr, "leIntObj oc %d op1 %p op2 %p\n", ip->argc, ip->argv[0], ip->argv[1]); + + // for the time being, we compare two int values + obj = proc->slots[PTR2INT(ip->argv[0])]; + if (likely(obj->typePtr == Nsf_OT_intType)) { + value1 = obj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, obj, &value1); + } + obj = proc->slots[PTR2INT(ip->argv[1])]; + if (likely(obj->typePtr == Nsf_OT_intType)) { + value2 = obj->internalRep.longValue; + } else { + Tcl_GetIntFromObj(interp, obj, &value2); + } + //fprintf(stderr, "asmLeScalar oc %d op1 %d op2 %d => %d\n", ip->argc, value1, value2, value1 <= value2); + + proc->status = value1 <= value2; + } + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmMethodDelegateDispatch: + + { Tcl_Command cmd = NULL; + NsfObject *object; + + // obj and method are unresolved + result = GetObjectFromObj(interp, ip->argv[0], &object); + if (likely(ip->clientData != NULL)) { + cmd = ip->clientData; + } else { + cmd = Tcl_GetCommandFromObj(interp, ip->argv[1]); + } + //fprintf(stderr, "cmd %p object %p\n", cmd, object); + result = MethodDispatch(object, interp, ip->argc-1, ip->argv+1, cmd, object, NULL, + ObjStr(ip->argv[1]), 0, 0); + } + goto EXEC_RESULT_CODE_HANDLER; + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmMethodDelegateDispatch11: + + // obj and method are resolved + { + AsmResolverInfo *resInfo = ip->clientData; + result = MethodDispatch(resInfo->object, interp, ip->argc-1, ip->argv+1, + resInfo->cmd, resInfo->object, NULL, + ObjStr(ip->argv[1]), 0, 0); + } + goto EXEC_RESULT_CODE_HANDLER; + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmMethodSelfCmdDispatch: + + { + AsmResolverInfo *resInfo = ip->clientData; + assert(resInfo->cmd != NULL); + result = Tcl_NRCallObjProc(interp, Tcl_Command_objProc(resInfo->cmd), resInfo->proc->currentObject, + ip->argc, ip->argv); + } + goto EXEC_RESULT_CODE_HANDLER; + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmMethodSelfDispatch: + + { + AsmResolverInfo *resInfo = ip->clientData; + Tcl_Command cmd = resInfo->cmd ? resInfo->cmd : Tcl_GetCommandFromObj(interp, ip->argv[0]); + + result = MethodDispatch(resInfo->proc->currentObject, interp, + ip->argc, ip->argv, + cmd, resInfo->proc->currentObject, NULL, + ObjStr(ip->argv[0]), 0, 0); + } + goto EXEC_RESULT_CODE_HANDLER; + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmNoop: + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmSelf: + + Tcl_SetObjResult(interp, proc->currentObject->cmdName); + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmSetInt: + + proc->slots[PTR2INT(ip->argv[0])] = ip->argv[1]; + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmSetObj: + + //fprintf(stderr, "setObj var[%d] = %s\n", PTR2INT(ip->argv[0]), ObjStr(ip->argv[1])); + proc->slots[PTR2INT(ip->argv[0])] = ip->argv[1]; + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmSetObjToResult: + + //fprintf(stderr, "setObjToResult var[%d] = %s\n", PTR2INT(ip->argv[0]), ObjStr(ip->argv[1])); + proc->slots[PTR2INT(ip->argv[0])] = Tcl_GetObjResult(interp); + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmSetResult: + + Tcl_SetObjResult(interp, proc->slots[PTR2INT(ip->argv[0])]); + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmSetResultInt: + + Tcl_SetObjResult(interp, Tcl_NewIntObj(PTR2INT(proc->slots[PTR2INT(ip->argv[0])]))); + + ip++; + goto *instructionLabel[ip->labelIdx]; + +INST_asmStoreResult: + + ip->argv[0] = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(ip->argv[0]); + + ip++; + goto *instructionLabel[ip->labelIdx]; + + +} + Fisheye: Tag 9333bfa110291a29fa898b0ce554e8848db5d031 refers to a dead (removed) revision in file `generic/asmExecuteTemplateLabelThreading.c'. Fisheye: No comparison available. Pass `N' to diff? Fisheye: Tag 9333bfa110291a29fa898b0ce554e8848db5d031 refers to a dead (removed) revision in file `generic/genAssemble.tcl'. Fisheye: No comparison available. Pass `N' to diff? Index: generic/nsf.c =================================================================== diff -u -r04e3056621ba12a8eacb56a92f5d3d00fdbbbfbb -r9333bfa110291a29fa898b0ce554e8848db5d031 --- generic/nsf.c (.../nsf.c) (revision 04e3056621ba12a8eacb56a92f5d3d00fdbbbfbb) +++ generic/nsf.c (.../nsf.c) (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -1,4 +1,3 @@ -#define NSF_ASSEMBLE 1 /* * nsf.c -- * @@ -17867,7 +17866,7 @@ } #if defined(NSF_ASSEMBLE) -# include "nsfAssemble.c" +# include "asm/nsfAssemble.c" #else static int NsfAsmMethodCreateCmd(Tcl_Interp *interp, NsfObject *defObject, Index: library/lib/nx-test.tcl =================================================================== diff -u -r04e3056621ba12a8eacb56a92f5d3d00fdbbbfbb -r9333bfa110291a29fa898b0ce554e8848db5d031 --- library/lib/nx-test.tcl (.../nx-test.tcl) (revision 04e3056621ba12a8eacb56a92f5d3d00fdbbbfbb) +++ library/lib/nx-test.tcl (.../nx-test.tcl) (revision 9333bfa110291a29fa898b0ce554e8848db5d031) @@ -97,13 +97,15 @@ if {[info exists :pre]} {:call "pre" ${:pre}} if {![info exists :msg]} {set :msg ${:cmd}} set gotError [catch {:call "run" ${:cmd}} r] + #puts stderr "gotError = $gotError // $r == ${:expected} // [info exists :setResult]" if {[info exists :setResult]} {set r [eval [set :setResult]]} if {$r eq ${:expected}} { if {$gotError} { set c 1 } else { if {[info exists :count]} {set c ${:count}} {set c 1000} } + #puts stderr "running test $c times" if {[:verbose]} {puts stderr "running test $c times"} if {$c > 1} { set r0 [time {time {::namespace eval ${:namespace} ";"} $c}] @@ -112,7 +114,7 @@ #puts stderr "running {time {::namespace eval ${:namespace} ${:cmd}} $c} => $r1" regexp {^(-?[0-9]+) +} $r1 _ mS1 set ms [expr {($mS1 - $mS0) * 1.0 / $c}] - puts stderr "[set :name]:\t[format %6.2f $ms] mms, ${:msg} (overhead [format %.2f [expr {$mS0*1.0/$c}]])" + puts stderr "[set :name]:\t[format %6.2f $ms]\tmms, ${:msg} (overhead [format %.2f [expr {$mS0*1.0/$c}]])" } else { puts stderr "[set :name]: ${:msg} ok" }