Author: coke Date: Sun Jul 27 11:57:09 2008 New Revision: 29804 Added: trunk/languages/tcl/runtime/builtin/break.pir trunk/languages/tcl/runtime/builtin/cd.pir trunk/languages/tcl/runtime/builtin/continue.pir trunk/languages/tcl/runtime/builtin/eof.pir trunk/languages/tcl/runtime/builtin/exit.pir trunk/languages/tcl/runtime/builtin/flush.pir trunk/languages/tcl/runtime/builtin/for.pir trunk/languages/tcl/runtime/builtin/incr.pir trunk/languages/tcl/runtime/builtin/join.pir trunk/languages/tcl/runtime/builtin/llength.pir trunk/languages/tcl/runtime/builtin/lrange.pir trunk/languages/tcl/runtime/builtin/pwd.pir trunk/languages/tcl/runtime/builtin/set.pir trunk/languages/tcl/runtime/builtin/time.pir trunk/languages/tcl/runtime/builtin/while.pir Removed: trunk/languages/tcl/src/builtin/ trunk/languages/tcl/tools/gen_inline.pl Modified: trunk/languages/tcl/config/makefiles/root.in trunk/languages/tcl/runtime/builtin/proc.pir trunk/languages/tcl/runtime/builtin/rename.pir trunk/languages/tcl/src/grammar/expr/past2pir.tg trunk/languages/tcl/tools/gen_builtins.pl
Log: [tcl] http://code.google.com/p/partcl/issues/detail?id=59 Part of the eventual switch to PCT involves changing how we attempt to compile. This reverts tcl to a pure runtime dispatch for each command; The ".tmt" files we had been using to generate PIR to use in place of the runtime call are now gone. In most cases, just used the version that had been automatically generated by the original system. Modified: trunk/languages/tcl/config/makefiles/root.in ============================================================================== --- trunk/languages/tcl/config/makefiles/root.in (original) +++ trunk/languages/tcl/config/makefiles/root.in Sun Jul 27 11:57:09 2008 @@ -9,7 +9,6 @@ #CONDITIONED_LINE(darwin):# MACOSX_DEPLOYMENT_TARGET must be defined for OS X compilation/linking #CONDITIONED_LINE(darwin):export MACOSX_DEPLOYMENT_TARGET := @osx_version@ -C_BUILTIN = src/builtin TCL_LIB = library PMCBUILD = $(PERL) @build_dir@/tools/build/dynpmc.pl OPSBUILD = $(PERL) @build_dir@/tools/build/dynoplibs.pl @@ -42,29 +41,9 @@ tclarray \ tcldict -GENERATED_INLINES = \ - $(C_BUILTIN)/break.pir \ - $(C_BUILTIN)/continue.pir \ - $(C_BUILTIN)/eof.pir \ - $(C_BUILTIN)/exit.pir \ - $(C_BUILTIN)/flush.pir \ - $(C_BUILTIN)/for.pir \ - $(C_BUILTIN)/incr.pir \ - $(C_BUILTIN)/join.pir \ - $(C_BUILTIN)/llength.pir \ - $(C_BUILTIN)/lrange.pir \ - $(C_BUILTIN)/pwd.pir \ - $(C_BUILTIN)/set.pir \ - $(C_BUILTIN)/time.pir \ - $(C_BUILTIN)/while.pir - RUNTIME_PIR = $(addprefix runtime/builtin/,$(notdir $(wildcard languages/tcl/runtime/builtin/*.pir))) DEPS = \ -$(C_BUILTIN)/cd.pir \ -$(C_BUILTIN)/expr.pir \ -$(C_BUILTIN)/list.pir \ -$(C_BUILTIN)/return.pir \ runtime/conversions.pir \ runtime/string_to_list.pir \ runtime/variables.pir \ @@ -85,12 +64,7 @@ tcl.pbc: $(PARROT) pmcs ops runtime/tcllib.pbc src/tclsh.pir $(PARROT) --output=tcl.pbc src/tclsh.pir -$(GENERATED_INLINES) : tools/gen_inline.pl - -.SUFFIXES : .pir .tmt .pg .tg .tcl - -.tmt.pir : - $(PERL) tools/gen_inline.pl $< > $@ +.SUFFIXES : .pir .pg .tg .tcl .tg.pir : $(PARROT) $(TGE_DIR)/tgc.pir --output=$@ $< @@ -129,7 +103,7 @@ @cd $(OPSDIR) && $(OPSBUILD) linklibs tcl ../binary$(O) @cd $(OPSDIR) && $(OPSBUILD) copy "--destination=$(DESTDIR)" tcl -runtime/builtins.pir: $(GENERATED_INLINES) $(DEPS) tools/gen_builtins.pl +runtime/builtins.pir: $(DEPS) tools/gen_builtins.pl $(PERL) tools/gen_builtins.pl > runtime/builtins.pir runtime/tcllib.pbc: $(PARROT) runtime/tcllib.pir runtime/builtins.pir $(CLASSES) @@ -326,7 +300,6 @@ src/grammar/expr/expression.pir \ src/grammar/expr/past2pir.pir \ src/grammar/expr/pge2past.pir \ -$(GENERATED_INLINES) \ "$(OPSDIR)/*.c" \ "$(OPSDIR)/*.h" \ "src/*$(O)" \ Added: trunk/languages/tcl/runtime/builtin/break.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/break.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,22 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&break' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + + if argc != 0 goto bad_args + + tcl_break + +bad_args: + tcl_error 'wrong # args: should be "break"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: Added: trunk/languages/tcl/runtime/builtin/cd.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/cd.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,34 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&cd' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + + if argc >= 2 goto bad_args + if argc == 0 goto noargs + + .local string dir + dir = argv[0] + goto cd_it + +noargs: + $P0 = new 'Env' + dir = $P0['HOME'] + +cd_it: + $P0 = new 'OS' + $S0 = $P0.'chdir'(dir) + .return ($S0) + +bad_args: + tcl_error 'wrong # args: should be "cd ?dirName?"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: Added: trunk/languages/tcl/runtime/builtin/continue.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/continue.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,22 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&continue' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + + if argc != 0 goto bad_args + + tcl_continue + +bad_args: + tcl_error 'wrong # args: should be "continue"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: Added: trunk/languages/tcl/runtime/builtin/eof.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/eof.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,30 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&eof' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + + if argc != 1 goto bad_args + + .local pmc getChannel,channel + getChannel = get_root_global ['_tcl'], 'getChannel' + + channel = shift argv + channel = getChannel(channel) + + .local int eof + eof = isfalse channel + + .return(eof) +bad_args: + tcl_error 'wrong # args: should be "eof channelId"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: Added: trunk/languages/tcl/runtime/builtin/exit.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/exit.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,36 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&exit' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + + if argc > 1 goto bad_args + + .local int returnCode + returnCode = 0 + if argc == 0 goto got_returnCode + + .local pmc toInteger + toInteger = get_root_global ['_tcl'], 'toInteger' + .local pmc arg + arg = shift argv + arg = toInteger(arg) + + returnCode = arg + +got_returnCode: + + exit returnCode + +bad_args: + tcl_error 'wrong # args: should be "exit ?returnCode?"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: Added: trunk/languages/tcl/runtime/builtin/flush.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/flush.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,29 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&flush' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + + if argc != 1 goto bad_args + + .local pmc getChannel,channel + getChannel = get_root_global ['_tcl'], 'getChannel' + + channel = shift argv + channel = getChannel(channel) + + channel.'flush'() + + .return('') +bad_args: + tcl_error 'wrong # args: should be "flush channelId"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: Added: trunk/languages/tcl/runtime/builtin/for.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/for.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,66 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&for' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc != 4 goto bad_args + # get necessary conversion subs + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' + .local pmc compileExpr + compileExpr = get_root_global ['_tcl'], 'compileExpr' + .local pmc a_start + a_start = argv[0] + a_start = compileTcl(a_start) + .local pmc a_test + a_test = argv[1] + a_test = compileExpr(a_test) + .local pmc a_next + a_next = argv[2] + a_next = compileTcl(a_next) + .local pmc a_command + a_command = argv[3] + a_command = compileTcl(a_command) + .local pmc R + .local pmc temp + + .local pmc toBoolean + toBoolean = get_root_global ['_tcl'], 'toBoolean' +temp = a_start() +loop: +temp = a_test() + $P0 = temp + $I0 = toBoolean($P0) + unless $I0 goto done + push_eh command_exception +temp = a_command() + pop_eh +continue: + push_eh next_exception +temp = a_next() + pop_eh + goto loop + +command_exception: + .catch() + .get_return_code($I0) + if $I0 == .CONTROL_CONTINUE goto continue + if $I0 == .CONTROL_BREAK goto done + .rethrow() + +next_exception: + .catch() + .get_return_code($I0) + if $I0 == .CONTROL_BREAK goto done + .rethrow() + +done: + R = new 'String' + R = '' + .return(R) +bad_args: + tcl_error 'wrong # args: should be "for start test next command"' +.end Added: trunk/languages/tcl/runtime/builtin/incr.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/incr.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,38 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&incr' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc < 1 goto bad_args + if argc > 2 goto bad_args + # get necessary conversion subs + .local pmc toInteger + toInteger = get_root_global ['_tcl'], 'toInteger' + .local pmc readVar + readVar = get_root_global ['_tcl'], 'readVar' + .local pmc a_varName + a_varName = argv[0] + a_varName = readVar(a_varName) + a_varName = toInteger(a_varName) + .local pmc a_increment + if argc < 2 goto default_increment + a_increment = argv[1] + a_increment = toInteger(a_increment) + goto done_increment +default_increment: + a_increment = new 'TclInt' + a_increment = 1 +done_increment: + .local pmc R + .local pmc temp + +a_varName += a_increment +R = clone a_varName + .return(R) +bad_args: + tcl_error 'wrong # args: should be "incr varName ?increment?"' +.end + Added: trunk/languages/tcl/runtime/builtin/join.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/join.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,32 @@ +.sub '&join' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc < 1 goto bad_args + if argc > 2 goto bad_args + # get necessary conversion subs + .local pmc toList + toList = get_root_global ['_tcl'], 'toList' + .local pmc a_list + a_list = argv[0] + a_list = toList(a_list) + .local pmc a_joinString + if argc < 2 goto default_joinString + a_joinString = argv[1] + goto done_joinString +default_joinString: + a_joinString = new 'TclString' + a_joinString = ' ' +done_joinString: + .local pmc R + .local pmc temp + +$S0 = a_joinString +$S0 = join $S0, a_list +R = new 'TclString' +R = $S0 + .return(R) +bad_args: + tcl_error 'wrong # args: should be "join list ?joinString?"' +.end Added: trunk/languages/tcl/runtime/builtin/llength.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/llength.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,25 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&llength' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc != 1 goto bad_args + # get necessary conversion subs + .local pmc toList + toList = get_root_global ['_tcl'], 'toList' + .local pmc a_list + a_list = argv[0] + a_list = toList(a_list) + .local pmc R + .local pmc temp + +$I0 = elements a_list +R = new 'TclInt' +R = $I0 + .return(R) +bad_args: + tcl_error 'wrong # args: should be "llength list"' +.end Added: trunk/languages/tcl/runtime/builtin/lrange.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/lrange.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,57 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&lrange' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc != 3 goto bad_args + # get necessary conversion subs + .local pmc toList + toList = get_root_global ['_tcl'], 'toList' + .local pmc a_list + a_list = argv[0] + a_list = toList(a_list) + .local pmc a_first + a_first = argv[1] + .local pmc a_last + a_last = argv[2] + .local pmc R + .local pmc temp + + .local pmc getIndex + getIndex = get_root_global ['_tcl'], 'getIndex' + + .local int from, to + from = getIndex(a_first, a_list) + to = getIndex(a_last, a_list) + + if from < 0 goto set_first +have_first: + $I0 = elements a_list + if $I0 < to goto set_last + + goto have_indices + +set_first: + from = 0 + goto have_first + +set_last: + to = $I0 - 1 + +have_indices: + $I0 = from + R = new 'TclList' +loop: + if $I0 > to goto end + $P0 = a_list[$I0] + push R, $P0 + inc $I0 + goto loop +end: + .return(R) +bad_args: + tcl_error 'wrong # args: should be "lrange list first last"' +.end Modified: trunk/languages/tcl/runtime/builtin/proc.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/proc.pir (original) +++ trunk/languages/tcl/runtime/builtin/proc.pir Sun Jul 27 11:57:09 2008 @@ -46,7 +46,7 @@ if $I0 == 0 goto create name = pop ns - if $I0 == 1 goto root + if $I0 == 1 goto create $P0 = get_hll_namespace ns if null $P0 goto unknown_namespace @@ -55,22 +55,6 @@ namespace .= "']" goto create -root: - # check to see if this is inlinable - # if it is, we need to update the epoch - $S0 = name - $P1 = get_root_global ['_tcl'; 'builtins'], $S0 - if null $P1 goto create - - .local pmc epoch - epoch = get_root_global ['_tcl'], 'epoch' - inc epoch - - # now we need to delete the helper sub - # so we don't try to inline anything else - $P1 = get_root_namespace ['_tcl'; 'builtins'] - delete $P1[$S0] - create: code.emit(<<'END_PIR', namespace, name) .sub 'xxx' :anon Added: trunk/languages/tcl/runtime/builtin/pwd.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/pwd.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,26 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&pwd' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc != 0 goto bad_args + # get necessary conversion subs + .local pmc R + .local pmc temp + +R = new 'OS' +R = R.'cwd'() + .return(R) +bad_args: + tcl_error 'wrong # args: should be "pwd"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: + Modified: trunk/languages/tcl/runtime/builtin/rename.pir ============================================================================== --- trunk/languages/tcl/runtime/builtin/rename.pir (original) +++ trunk/languages/tcl/runtime/builtin/rename.pir Sun Jul 27 11:57:09 2008 @@ -37,7 +37,7 @@ delete_sub: delete ns[$S0] - if delete_only goto delete_builtin + if delete_only goto return add_sub: # Create the new sub @@ -53,19 +53,8 @@ set_new_sub: ns[$S0] = sub - -delete_builtin: - builtin = get_root_global ['_tcl'; 'builtins'], oldName - if null builtin goto return - - $P0 = get_root_namespace ['_tcl'; 'builtins'] - delete $P0[oldName] - if delete_only goto return -add_builtin: - set_root_global ['_tcl'; 'builtins'], newName, builtin - return: .return('') Added: trunk/languages/tcl/runtime/builtin/set.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/set.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,48 @@ +.HLL 'Tcl', 'tcl_group' +.namespace [] + +.sub '&set' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc < 1 goto bad_args + if argc > 2 goto bad_args + # get necessary conversion subs + .local pmc a_varName + a_varName = argv[0] + .local pmc a_newValue + if argc < 2 goto default_newValue + a_newValue = argv[1] + goto done_newValue +default_newValue: + null a_newValue +done_newValue: + .local pmc R + .local pmc temp + + if null a_newValue goto read_var + + .local pmc set + set = get_root_global ['_tcl'], 'setVar' + R = set(a_varName, a_newValue) + goto end + +read_var: + .local pmc read + read = get_root_global ['_tcl'], 'readVar' + R = read(a_varName) + +end: + R = clone R + .return(R) +bad_args: + tcl_error 'wrong # args: should be "set varName ?newValue?"' +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: + Added: trunk/languages/tcl/runtime/builtin/time.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/time.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,71 @@ +.sub '&time' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc < 1 goto bad_args + if argc > 2 goto bad_args + # get necessary conversion subs + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' + .local pmc toInteger + toInteger = get_root_global ['_tcl'], 'toInteger' + .local pmc a_command + a_command = argv[0] + a_command = compileTcl(a_command) + .local pmc a_count + if argc < 2 goto default_count + a_count = argv[1] + a_count = toInteger(a_count) + goto done_count +default_count: + a_count = new 'TclInt' + a_count = 1 +done_count: + .local pmc R + .local pmc temp + + $I0 = a_count + if $I0 > 0 goto time_something + + R = new 'TclString' + R = '0 microseconds per iteration' + goto time_end + +time_something: + .local num t + t = time +time_loop: + if $I0 == 0 goto time_done + +temp = a_command() + + dec $I0 + goto time_loop + +time_done: + $N0 = time + t = $N0 - t + t *= 1000000 + + $N0 = a_count + t /= $N0 + $I0 = t + $S0 = $I0 + $S0 .= ' microseconds per iteration' + + R = new 'TclString' + R = $S0 +time_end: + .return(R) +bad_args: + tcl_error 'wrong # args: should be "time command ?count?"' +.end + + +# Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: + Added: trunk/languages/tcl/runtime/builtin/while.pir ============================================================================== --- (empty file) +++ trunk/languages/tcl/runtime/builtin/while.pir Sun Jul 27 11:57:09 2008 @@ -0,0 +1,48 @@ +.sub '&while' + .param pmc argv :slurpy + + .local int argc + argc = elements argv + if argc != 2 goto bad_args + # get necessary conversion subs + .local pmc compileTcl + compileTcl = get_root_global ['_tcl'], 'compileTcl' + .local pmc compileExpr + compileExpr = get_root_global ['_tcl'], 'compileExpr' + .local pmc a_test + a_test = argv[0] + a_test = compileExpr(a_test) + .local pmc a_command + a_command = argv[1] + a_command = compileTcl(a_command) + .local pmc R + .local pmc temp + + .local pmc toBoolean + toBoolean = get_root_global ['_tcl'], 'toBoolean' +while_loop: +temp = a_test() + $P0 = temp + $I0 = toBoolean($P0) + unless $I0 goto while_loop_done + + push_eh while_loop_exception +temp = a_command() + pop_eh + + goto while_loop + +while_loop_exception: + .catch() + .get_return_code($I0) + if $I0 == .CONTROL_CONTINUE goto while_loop + if $I0 == .CONTROL_BREAK goto while_loop_done + .rethrow() + +while_loop_done: + R = new 'TclString' + R = '' + .return(R) +bad_args: + tcl_error 'wrong # args: should be "while test command"' +.end Modified: trunk/languages/tcl/src/grammar/expr/past2pir.tg ============================================================================== --- trunk/languages/tcl/src/grammar/expr/past2pir.tg (original) +++ trunk/languages/tcl/src/grammar/expr/past2pir.tg Sun Jul 27 11:57:09 2008 @@ -208,9 +208,6 @@ $P0 = shift iter name = $P0['value'] - .local int has_expand - has_expand = 0 - iter_loop: unless iter goto iter_done $P1 = shift iter @@ -219,13 +216,10 @@ push args, reg pir .= $P0 $S0 = typeof $P1 - if $S0 == 'PAST::Expand' goto iter_expand + if $S0 == 'PAST::Expand' goto iter_loop unless $S0 == 'PAST::Var' goto iter_loop pir.emit(" %0 = clone %0", reg) goto iter_loop - iter_expand: - has_expand = 1 - goto iter_loop iter_done: .local string retval retval = pir.unique('$P') @@ -237,22 +231,7 @@ $P0 = shift children $S0 = $P0['value'] - if has_expand goto dynamic - $P1 = get_root_global ['_tcl'; 'builtins'], $S0 - if null $P1 goto dynamic - - $P0 = $P1(retval, children,args) - if null $P0 goto dynamic - - .local pmc epoch - epoch = get_root_global ['_tcl'], 'epoch' - $S0 = pir.unique('dynamic_') - pir.emit(' if epoch != %0 goto %1', epoch, $S0) - pir .= $P0 - pir.emit(' goto %0', done_) - pir.emit('%0:', $S0) - dynamic: .local string ns ns = '' $S0 = join ", ", args Modified: trunk/languages/tcl/tools/gen_builtins.pl ============================================================================== --- trunk/languages/tcl/tools/gen_builtins.pl (original) +++ trunk/languages/tcl/tools/gen_builtins.pl Sun Jul 27 11:57:09 2008 @@ -8,7 +8,6 @@ use lib qw(lib); my $static_dir = 'runtime/builtin'; -my $dynamic_dir = 'src/builtin'; print <<EOH; # This file automatically generated by $0. @@ -18,26 +17,10 @@ # commands that are in Tcl's :: namespace directly my @static_cmds = pir_cmds_in_dir($static_dir); -# subroutines that generate the PIR for Tcl commands -my @dynamic_cmds = pir_cmds_in_dir($dynamic_dir); - print " .HLL 'tcl', 'tcl_group'\n"; -print " .include 'languages/tcl/$dynamic_dir/$_.pir'\n" for @dynamic_cmds; - -#print <<'END_PIR'; -# -#.HLL 'tcl', 'tcl_group' -#.namespace [] -# -#END_PIR - print " .include 'languages/tcl/$static_dir/$_.pir'\n" for @static_cmds; -# For every builtin with an inline'd version and no interpreted version, -# create a shim for the interpreted version that automatically calls -# the inline'd version, compiles the result and invokes it. - sub pir_cmds_in_dir { my ($dir) = @_;
