Index: Makefile.in =================================================================== diff -u -N -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) Index: asm.tcl =================================================================== diff -u -N --- asm.tcl (revision 66f91dca78bc8c4e9963c8e8039183298f0c0f09) +++ asm.tcl (revision 0) @@ -1,307 +0,0 @@ -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 -} -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} -} -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: configure =================================================================== diff -u -N -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 -N -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 -N --- 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 -N --- 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 -N --- 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 -N --- 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 -N --- 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 -N --- 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 -N --- 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 -N --- 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 -N --- 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]; + + +} + Index: generic/asmExecuteTemplateLabelThreading.c =================================================================== diff -u -N --- generic/asmExecuteTemplateLabelThreading.c (revision 66f91dca78bc8c4e9963c8e8039183298f0c0f09) +++ generic/asmExecuteTemplateLabelThreading.c (revision 0) @@ -1,344 +0,0 @@ - -enum instructionIdx { - IDX_objProc, - $INSTRUCTION_INDICES, - IDX_NULL -}; - -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 -}; - -/* - *---------------------------------------------------------------------- - * 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, indexValue; - NsfObject *object; - Tcl_Command cmd; - 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 -} - - -/* - *---------------------------------------------------------------------- - * 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/genAssemble.tcl =================================================================== diff -u -N --- generic/genAssemble.tcl (revision 66f91dca78bc8c4e9963c8e8039183298f0c0f09) +++ generic/genAssemble.tcl (revision 0) @@ -1,566 +0,0 @@ -package require nx -###################################################################### -# The code engine -###################################################################### - -nsf::proc generate {threadingType:class} { - Instruction mixin add ${threadingType}::Instruction - set suffix [string trimleft ${threadingType} :] - set dirName [file dirname [info script]] - 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] - } - Instruction mixin delete ${threadingType}::Instruction - set INSTRUCTION_LABELS [join $labels ",\n "] - set INSTRUCTION_INDICES [join $indices ",\n "] - - 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]}" - } - set STATEMENT_INDICES [join $statementIndex ",\n "] - set STATEMENT_NAMES [join $statementNames ",\n "] - set STATEMENT_INFO [join $statementInfo ",\n "] - - set ASSEMBLE_CHECK_CODE "" - - set fn $dirName/asmExecuteTemplate$suffix.c - set f [open $fn]; set template [read $f]; close $f - - set f [open $dirName/nsfAsmExecute$suffix.c w] - puts $f [subst -nocommand -nobackslash $template] - 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} - } -} - -###################################################################### -# 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 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}" - } - } -} - -###################################################################### -# Code Generator for Label Threading -###################################################################### - -nx::Class create LabelThreading { - 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 mustAssign ip - :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 append [:labelName]:\n - :code generate - :nextInstruction - 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 { - // 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])); - ip = &proc->code[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])); - ip = &proc->code[PTR2INT(ip->argv[0])]; - } else { - //fprintf(stderr, "asmJumpTrue fall through\n"); - ip++; - } - } - - # {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 { - 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 \ No newline at end of file Index: generic/nsf.c =================================================================== diff -u -N -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 -N -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" }