Author: coke
Date: Thu Oct 6 09:19:57 2005
New Revision: 9369
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles/tcl.in
trunk/languages/tcl/lib/builtins/break.pir
trunk/languages/tcl/lib/builtins/continue.pir
trunk/languages/tcl/lib/builtins/incr.pir
trunk/languages/tcl/lib/commands/catch.pir
trunk/languages/tcl/lib/commands/eval.pir
trunk/languages/tcl/lib/commands/expr.pir
trunk/languages/tcl/lib/commands/for.pir
trunk/languages/tcl/lib/commands/foreach.pir
trunk/languages/tcl/lib/commands/if.pir
trunk/languages/tcl/lib/commands/proc.pir
trunk/languages/tcl/lib/commands/source.pir
trunk/languages/tcl/lib/commands/switch.pir
trunk/languages/tcl/lib/commands/time.pir
trunk/languages/tcl/lib/commands/uplevel.pir
trunk/languages/tcl/lib/commands/while.pir
trunk/languages/tcl/lib/expression.pir
trunk/languages/tcl/lib/parser.pir
trunk/languages/tcl/lib/tclbinaryops.pir
trunk/languages/tcl/lib/tclcommand.pir
trunk/languages/tcl/lib/tclconst.pir
trunk/languages/tcl/lib/tclfunc.pir
trunk/languages/tcl/lib/tclops.pir
trunk/languages/tcl/lib/tclword.pir
trunk/languages/tcl/tcl.pir
trunk/languages/tcl/tcl.pir_template
Log:
tcl: move the three compilers towards a single compiler: (internal code,
externally available
tcl compiler, expression compiler).
inline [for], taking advantage of this new system.
Fail a few more tests.
Re-Fix the heredocs in the builtins area. (must escape double quotes.)
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Thu Oct 6 09:19:57 2005
@@ -1403,7 +1403,9 @@ languages/tcl/examples/koohii.tcl
languages/tcl/examples/power.tcl [tcl]
languages/tcl/lib/builtins/break.pir [tcl]
languages/tcl/lib/builtins/continue.pir [tcl]
+languages/tcl/lib/builtins/for.pir [tcl]
languages/tcl/lib/builtins/incr.pir [tcl]
+languages/tcl/lib/builtins/while.pir [tcl]
languages/tcl/lib/commands/after.pir [tcl]
languages/tcl/lib/commands/append.pir [tcl]
languages/tcl/lib/commands/array.pir [tcl]
Modified: trunk/config/gen/makefiles/tcl.in
==============================================================================
--- trunk/config/gen/makefiles/tcl.in (original)
+++ trunk/config/gen/makefiles/tcl.in Thu Oct 6 09:19:57 2005
@@ -30,6 +30,7 @@ lib${slash}commands${slash}error.pir \
lib${slash}commands${slash}eval.pir \
lib${slash}commands${slash}exit.pir \
lib${slash}commands${slash}expr.pir \
+lib${slash}builtins${slash}for.pir \
lib${slash}commands${slash}for.pir \
lib${slash}commands${slash}foreach.pir \
lib${slash}commands${slash}format.pir \
@@ -66,6 +67,7 @@ lib${slash}commands${slash}unknown.pir \
lib${slash}commands${slash}unset.pir \
lib${slash}commands${slash}uplevel.pir \
lib${slash}commands${slash}upvar.pir \
+lib${slash}builtins${slash}while.pir \
lib${slash}commands${slash}while.pir \
lib${slash}conversions.pir \
lib${slash}expression.pir \
Modified: trunk/languages/tcl/lib/builtins/break.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/break.pir (original)
+++ trunk/languages/tcl/lib/builtins/break.pir Thu Oct 6 09:19:57 2005
@@ -15,7 +15,7 @@
badargs:
pir_code =<<"END_PIR"
-.throw('wrong # args: should be "break"')
+.throw('wrong # args: should be \"break\"')
END_PIR
.return(register_num,pir_code)
Modified: trunk/languages/tcl/lib/builtins/continue.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/continue.pir (original)
+++ trunk/languages/tcl/lib/builtins/continue.pir Thu Oct 6 09:19:57 2005
@@ -15,7 +15,7 @@
badargs:
pir_code =<<"END_PIR"
-.throw('wrong # args: should be "continue"')
+.throw('wrong # args: should be \"continue\"')
END_PIR
.return(register_num,pir_code)
Modified: trunk/languages/tcl/lib/builtins/incr.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/incr.pir (original)
+++ trunk/languages/tcl/lib/builtins/incr.pir Thu Oct 6 09:19:57 2005
@@ -14,7 +14,7 @@
if argc > 2 goto error
.local pmc compiler
- compiler = find_global "_Tcl", "compile"
+ compiler = find_global "_Tcl", "compile_dispatch"
.local int value_num,increment_num
.local pmc value,increment
@@ -25,12 +25,14 @@
(value_num,temp_code) = compiler(value,register_num)
pir_code .= temp_code
register_num = value_num + 1
+
pir_code .= <<"END_PIR"
.local pmc read, set, number
read = find_global '_Tcl', '__read'
number = find_global '_Tcl', '__number'
set = find_global '_Tcl', '__set'
END_PIR
+
pir_code .= "$P"
$S0 = register_num
pir_code .= $S0
@@ -66,12 +68,14 @@ got_increment:
(value_num,temp_code) = compiler(value,register_num)
pir_code .= temp_code
register_num = value_num + 1
+
pir_code .= <<"END_PIR"
.local pmc read, set, number
read = find_global '_Tcl', '__read'
number = find_global '_Tcl', '__number'
set = find_global '_Tcl', '__set'
END_PIR
+
pir_code .= "$P"
$S0 = register_num
pir_code .= $S0
@@ -109,7 +113,7 @@ END_PIR
error:
pir_code =<<"END_PIR"
-.throw ('wrong # args: should be "incr varName ?increment?"')
+.throw ('wrong # args: should be \"incr varName ?increment?\"')
END_PIR
.return (register_num,pir_code)
Modified: trunk/languages/tcl/lib/commands/catch.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/catch.pir (original)
+++ trunk/languages/tcl/lib/commands/catch.pir Thu Oct 6 09:19:57 2005
@@ -10,18 +10,21 @@
argc = argv
.local int retval
- .local pmc code_retval,parse
+ .local pmc code_retval,compiler,pir_compiler
.local string varname,sigil_varname,code
- parse = find_global "_Tcl", "parse"
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
if argc == 0 goto badargs
if argc > 2 goto badargs
code = argv[0]
- $P1 = parse(code)
+ ($I0,$P1) = compiler(0,code)
+ $P2 = pir_compiler($I0,$P1)
+
push_eh non_ok
- code_retval = $P1()
+ code_retval = $P2()
retval = TCL_OK # no exception => TCL_OK
clear_eh
Modified: trunk/languages/tcl/lib/commands/eval.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/eval.pir (original)
+++ trunk/languages/tcl/lib/commands/eval.pir Thu Oct 6 09:19:57 2005
@@ -16,8 +16,9 @@
.local int looper
- .local pmc parse
- parse = find_global "_Tcl", "parse"
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
expr = ""
looper = 0
@@ -33,8 +34,9 @@ loop:
goto loop
loop_done:
- $P1 = parse(expr)
- .return $P1()
+ ($I0,$P1) = compiler(0,expr)
+ $P2 = pir_compiler($I0,$P1)
+ .return $P2()
no_args:
.throw("wrong # args: should be \"eval arg ?arg ...?\"")
Modified: trunk/languages/tcl/lib/commands/expr.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/expr.pir (original)
+++ trunk/languages/tcl/lib/commands/expr.pir Thu Oct 6 09:19:57 2005
@@ -14,9 +14,9 @@
.local int looper
.local pmc retval
- .local pmc expression_p
- .local pmc expression_i
- expression_p = find_global "_Tcl", "__expression_parse"
+ .local pmc expression_compiler,pir_compiler
+ expression_compiler = find_global "_Tcl", "__expression_compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
expr = ""
looper = 0
@@ -34,8 +34,9 @@ loop:
goto loop
loop_done:
- $P1 = expression_p(expr)
- .return $P1()
+ ($I0,$P1) = expression_compiler(0,expr)
+ $P2 = pir_compiler($I0,$P1)
+ .return $P2()
no_args:
.throw("wrong # args: should be \"expr arg ?arg ...?\"")
Modified: trunk/languages/tcl/lib/commands/for.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/for.pir (original)
+++ trunk/languages/tcl/lib/commands/for.pir Thu Oct 6 09:19:57 2005
@@ -1,3 +1,5 @@
+# XXX Convert to a call to the inline version.
+
###
# [for]
Modified: trunk/languages/tcl/lib/commands/foreach.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/foreach.pir (original)
+++ trunk/languages/tcl/lib/commands/foreach.pir Thu Oct 6 09:19:57 2005
@@ -4,7 +4,7 @@
.param pmc argv :slurpy
# Requires multiple of 3 args.
- .local pmc parse,retval
+ .local pmc compiler,pir_compiler,retval
.local int call_level
$P0 = find_global "_Tcl", "call_level"
@@ -19,7 +19,8 @@
.local pmc __list
__list = find_global "_Tcl", "__list"
- parse = find_global "_Tcl", "parse"
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
.local int argc
argc = argv
@@ -69,7 +70,8 @@ got_list:
goto arg_loop
arg_done:
.local pmc parsed
- parsed = parse(body)
+ ($I0,$P0) = compiler(0,body)
+ parsed = pir_compiler($I0,$P0)
register parsed
.local pmc iterator
Modified: trunk/languages/tcl/lib/commands/if.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/if.pir (original)
+++ trunk/languages/tcl/lib/commands/if.pir Thu Oct 6 09:19:57 2005
@@ -22,10 +22,10 @@
handling_else = 0
.local int counter
- .local pmc parse
- .local pmc expression_p
- parse = find_global "_Tcl", "parse"
- expression_p = find_global "_Tcl", "__expression_parse"
+ .local pmc compiler,pir_compiler,expr_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
+ expr_compiler = find_global "_Tcl", "__expression_compile"
.local string temp_str
temp_str =""
@@ -72,8 +72,9 @@ get_final:
if counter != argc goto more_than_else
begin_parsing:
- $P1 = expression_p(condition)
- retval = $P1()
+ ($I0,$S1) = expr_compiler(0,condition)
+ $P2 = pir_compiler($I0,$S1)
+ retval = $P2()
unless retval goto do_elseifs
code = body
@@ -87,8 +88,9 @@ elseif_loop:
if $I2 == $I1 goto do_else
$P1 = elseifs[$I2]
condition = $P1[0]
- $P2 = expression_p(condition)
- retval = $P2()
+ ($I0,$S2) = expr_compiler(0,condition)
+ $P3 = pir_compiler($I0,$S2)
+ retval = $P3()
if retval goto done_elseifs
inc $I2
goto elseif_loop
@@ -101,10 +103,10 @@ do_else:
code = else
done:
- $P1 = parse(code)
- register $P1
+ ($I0,$P1) = compiler(0,code)
+ $P2 = pir_compiler($I0,$P1)
- .return $P1()
+ .return $P2()
no_args:
.throw("wrong # args: no expression after \"if\" argument")
Modified: trunk/languages/tcl/lib/commands/proc.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/proc.pir (original)
+++ trunk/languages/tcl/lib/commands/proc.pir Thu Oct 6 09:19:57 2005
@@ -23,8 +23,9 @@ Create a PIR sub on the fly for this use
.local pmc retval
- .local pmc parse
- parse = find_global "_Tcl", "parse"
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
.local pmc __list
__list = find_global "_Tcl", "__list"
@@ -38,7 +39,8 @@ got_args:
# Save the parsed body.
.local pmc parsed_body
$S0 = body_p
- parsed_body = parse($S0)
+ ($I0,$P0) = compiler(0,$S0)
+ parsed_body = pir_compiler($I0,$P0)
register parsed_body
# XXX these need to go away - for now, we'll just escape
Modified: trunk/languages/tcl/lib/commands/source.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/source.pir (original)
+++ trunk/languages/tcl/lib/commands/source.pir Thu Oct 6 09:19:57 2005
@@ -12,9 +12,10 @@
.local string chunk, filename, contents
.local int type
- .local pmc retval, handle, parse
+ .local pmc retval, handle, compiler, pir_compiler
- parse = find_global "_Tcl", "parse"
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
$P1 = argv[0]
typeof type, $P1
@@ -37,8 +38,9 @@ loop:
goto loop
gotfile:
- $P1 = parse(contents)
- .return $P1()
+ ($I0,$P1) = compiler(0,contents)
+ $P2 = pir_compiler($I0,$P1)
+ .return $P2()
badfile:
$S0 = "couldn't read file \""
Modified: trunk/languages/tcl/lib/commands/switch.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/switch.pir (original)
+++ trunk/languages/tcl/lib/commands/switch.pir Thu Oct 6 09:19:57 2005
@@ -98,10 +98,12 @@ body_end:
.return ("")
body_match:
- .local pmc parse
- parse = find_global "_Tcl", "parse"
- $P0 = parse(code)
- .return $P0()
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
+ ($I0,$P0) = compiler(0,code)
+ $P1 = pir_compiler($I0,$P0)
+ .return $P1()
bad_args:
.throw("wrong # args: should be \"switch ?switches? string pattern body ...
?default body?\"")
Modified: trunk/languages/tcl/lib/commands/time.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/time.pir (original)
+++ trunk/languages/tcl/lib/commands/time.pir Thu Oct 6 09:19:57 2005
@@ -9,8 +9,9 @@
.local int argc
argc = argv
- .local pmc parse
- parse = find_global "_Tcl", "parse"
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
.local string script
.local int count
@@ -29,7 +30,8 @@ twoargs:
run:
script = argv[0]
- $P1 = parse(script)
+ ($I0,$P0) = compiler(0,script)
+ $P1 = pir_compiler($I0,$P0)
time $N1
$I1 = count
loop:
Modified: trunk/languages/tcl/lib/commands/uplevel.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/uplevel.pir (original)
+++ trunk/languages/tcl/lib/commands/uplevel.pir Thu Oct 6 09:19:57 2005
@@ -13,8 +13,9 @@
.local int argc
.local int looper
- .local pmc parse
- parse = find_global "_Tcl", "__parse"
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
# save the old call level
.local pmc old_call_level
@@ -51,6 +52,10 @@ loop_done:
store_global "_Tcl", "call_level", call_level
$P1 = parse(expr,0,0)
+
+ ($I0,$P0) = compiler(0,expr)
+ $P1 = pir_compiler($I0,$P0)
+
# can't quite tailcall this at the moment due to the hackish call_level
$P0 = $P1()
Modified: trunk/languages/tcl/lib/commands/while.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/while.pir (original)
+++ trunk/languages/tcl/lib/commands/while.pir Thu Oct 6 09:19:57 2005
@@ -14,22 +14,25 @@
condition = argv[0]
body = argv[1]
- .local pmc retval, parsed_code
+ .local pmc retval, compiled_code
- .local pmc parse
- .local pmc expression_p, compiled_condition
+ .local pmc compiler
+ .local pmc expression_compiler, pir_compiler, compiled_condition
- parse = find_global "_Tcl", "parse"
- expression_p = find_global "_Tcl", "__expression_parse"
-
- parsed_code = parse(body)
- compiled_condition = expression_p(condition)
+ compiler = find_global "_Tcl", "compile"
+ expression_compiler = find_global "_Tcl", "__expression_compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
+
+ ($I0,$P1) = compiler(0,body)
+ compiled_code = pir_compiler($I0,$P1)
+ ($I0,$P1) = expression_compiler(0,condition)
+ compiled_condition = pir_compiler($I0,$P1)
while_loop:
retval = compiled_condition()
unless retval goto done
push_eh handle_continue
- retval = parsed_code()
+ retval = compiled_code()
clear_eh
goto while_loop
Modified: trunk/languages/tcl/lib/expression.pir
==============================================================================
--- trunk/languages/tcl/lib/expression.pir (original)
+++ trunk/languages/tcl/lib/expression.pir Thu Oct 6 09:19:57 2005
@@ -10,14 +10,21 @@ and the functions ends with a tailcall t
=cut
-.sub __expression_parse
+.sub __expression_compile
+ .param int register_num
.param string expr
- $P1 = __expression_ast(expr)
- .return __expression_compile($P1)
+
+ .local pmc ast
+ ast = __expression_ast(expr)
+
+ .local pmc compiler
+ compiler = find_global "_Tcl", "compile_dispatch"
+ .return compiler(ast,register_num)
.end
.sub __expression_ast
.param string expr
+
.local pmc retval
.local pmc undef
@@ -506,43 +513,3 @@ unknown_func:
.return(unary, pos)
.end
-
-=head1 _Tcl::__expression_compile
-
-Given the AST generated by the expression parser, render the various operands
-as PIR.
-
-=cut
-
-.sub __expression_compile
- .param pmc thing
-
- .local pmc compile
- compile = find_global "_Tcl", "compile"
- .local string pir_code
-
- ($I0,pir_code) = compile(thing,0)
-
- .local pmc pir_compiler
- pir_compiler = compreg "PIR"
- # XXX deal with re-using sub name?
-
- $P1 = new .Array
- $P1 = 2
- $P1[0] = pir_code
- $P1[1] = $I0
-
- # Use n_operators pragma to force generation of new pmcs
- pir_code = sprintf ".pragma n_operators 1\n.sub blah :anon\n%s.return
($P%s)\n.end\n", $P1
-
- #print pir_code # for debugging the compiler
-
- # XXX HACK: can't tailcall these.
- $P1 = pir_compiler(pir_code)
- .return ($P1)
-
-die_horribly:
- .throw ("XXX: an error occurred compiling [expr]")
-
-.end
-
Modified: trunk/languages/tcl/lib/parser.pir
==============================================================================
--- trunk/languages/tcl/lib/parser.pir (original)
+++ trunk/languages/tcl/lib/parser.pir Thu Oct 6 09:19:57 2005
@@ -14,7 +14,7 @@ at <http://www.tcl.tk/man/tcl8.4/TclCmd/
=over 4
-=item C<pmc commands = parse(string tcl_code)>
+=item C<(int register_num, string pir_code) = compile(int register_num, string
tcl_code)>
Parses the Tcl code and returns an array of TclCommand objects.
First, it performs the \<newline> substitution. Then it fetches
@@ -22,7 +22,8 @@ commands, one at a time (skipping over c
=cut
-.sub parse
+.sub compile
+ .param int register_num
.param string tcl_code
.local int len
@@ -88,21 +89,35 @@ done_comment:
goto next_command
done:
- .local pmc pir_compiler
- .local int result_reg
- .local string pir_code
+ .return "compile_dispatch"(commands,register_num)
+.end
- (result_reg,pir_code) = "compile"(commands,0)
+.sub pir_compiler
+ .param int result_reg
+ .param string pir_code
+
+ .local pmc compiled_num
+ compiled_num = find_global "_Tcl", "compiled_num"
+ inc compiled_num
$P1 = new .Array
- $P1 = 2
- $P1[0] = pir_code
- $P1[1] = result_reg
-
- sprintf pir_code, ".pragma n_operators 1\n.sub blah :anon\n%s.return
($P%s)\n.end\n", $P1
+ $P1 = 3
+ $P1[0] = compiled_num
+ $P1[1] = pir_code
+ $P1[2] = result_reg
+
+ $S0 = <<"END_PIR"
+.pragma n_operators 1
+.sub compiled_tcl_sub%i :anon
+%s
+.return ($P%s)
+.end
+END_PIR
+ sprintf pir_code, $S0, $P1
#print pir_code
+ .local pmc pir_compiler
pir_compiler = compreg "PIR"
.return pir_compiler(pir_code)
@@ -634,7 +649,7 @@ and generate the code for it.
=cut
-.sub compile
+.sub compile_dispatch
.param pmc thing
.param int register_num
Modified: trunk/languages/tcl/lib/tclbinaryops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclbinaryops.pir (original)
+++ trunk/languages/tcl/lib/tclbinaryops.pir Thu Oct 6 09:19:57 2005
@@ -136,7 +136,7 @@ Initialize the attributes for an instanc
r_operand = getattribute self, "TclBinaryOp\x00r_operand"
- compile = find_global "_Tcl", "compile"
+ compile = find_global "_Tcl", "compile_dispatch"
.local string l_code,r_code,op_code
.local int l_reg,r_reg
Modified: trunk/languages/tcl/lib/tclcommand.pir
==============================================================================
--- trunk/languages/tcl/lib/tclcommand.pir (original)
+++ trunk/languages/tcl/lib/tclcommand.pir Thu Oct 6 09:19:57 2005
@@ -114,7 +114,7 @@ no_command_non_interactive:
inline_available=0
.local pmc compile
- compile = find_global "_Tcl", "compile"
+ compile = find_global "_Tcl", "compile_dispatch"
.local string pir_code
pir_code = ".include \"languages/tcl/lib/returncodes.pir\"\n"
Modified: trunk/languages/tcl/lib/tclconst.pir
==============================================================================
--- trunk/languages/tcl/lib/tclconst.pir (original)
+++ trunk/languages/tcl/lib/tclconst.pir Thu Oct 6 09:19:57 2005
@@ -271,7 +271,7 @@ Generate PIR code which can be used to g
value = getattribute self, $I0
.local pmc compiler
- compiler = find_global "_Tcl", "compile"
+ compiler = find_global "_Tcl", "compile_dispatch"
.return compiler(value,argnum)
.end
Modified: trunk/languages/tcl/lib/tclfunc.pir
==============================================================================
--- trunk/languages/tcl/lib/tclfunc.pir (original)
+++ trunk/languages/tcl/lib/tclfunc.pir Thu Oct 6 09:19:57 2005
@@ -55,7 +55,7 @@ Initialize the attributes for an instanc
.local pmc funcs, __number, compile
funcs = find_global "_Tcl", "functions"
__number = find_global "_Tcl", "__number"
- compile = find_global "_Tcl", "compile"
+ compile = find_global "_Tcl", "compile_dispatch"
# eventually, we'll need to deal with more than one arg.
Modified: trunk/languages/tcl/lib/tclops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclops.pir (original)
+++ trunk/languages/tcl/lib/tclops.pir Thu Oct 6 09:19:57 2005
@@ -41,7 +41,7 @@ Initialize the attributes for an instanc
.local pmc name, operand, compile
name = getattribute self, "TclUnaryOp\x00name"
operand = getattribute self, "TclUnaryOp\x00operand"
- compile = find_global "_Tcl", "compile"
+ compile = find_global "_Tcl", "compile_dispatch"
.local string opcode
Modified: trunk/languages/tcl/lib/tclword.pir
==============================================================================
--- trunk/languages/tcl/lib/tclword.pir (original)
+++ trunk/languages/tcl/lib/tclword.pir Thu Oct 6 09:19:57 2005
@@ -36,7 +36,7 @@ Define the attributes required for the c
compiled_args = new .TclList
.local pmc compiler
- compiler = find_global "_Tcl", "compile"
+ compiler = find_global "_Tcl", "compile_dispatch"
loop:
if i == len goto loop_done
Modified: trunk/languages/tcl/tcl.pir
==============================================================================
--- trunk/languages/tcl/tcl.pir (original)
+++ trunk/languages/tcl/tcl.pir Thu Oct 6 09:19:57 2005
@@ -37,8 +37,10 @@
.local pmc STDIN
STDIN = getstdin
- .local pmc parse
- parse = find_global "_Tcl", "parse"
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
+ compiler = find_global "_Tcl", "compile"
input_line = ""
__prompt(1)
@@ -47,8 +49,9 @@ input_loop:
input_line .= $S0
unless STDIN goto done
push_eh loop_error
- $P1 = parse(input_line)
- retval = $P1()
+ ($I0,$P1) = compiler(0,input_line)
+ $P2 = pir_compiler($I0,$P1)
+ retval = $P2()
clear_eh
# print out the result of the evaluation.
if_null retval, input_loop_continue
@@ -118,13 +121,15 @@ got_prompt:
$S0 = level
varname .= $S0
- .local pmc parse
- parse = find_global "_Tcl", "parse"
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
push_eh no_prompt
$P0 = find_global "Tcl", varname
- $P1 = parse($P0)
- $P1()
+ ($I0,$P1) = compiler(0,$P0)
+ $P2 = pir_compiler($I0,$P1)
+ $P2()
clear_eh
STDOUT."flush"()
Modified: trunk/languages/tcl/tcl.pir_template
==============================================================================
--- trunk/languages/tcl/tcl.pir_template (original)
+++ trunk/languages/tcl/tcl.pir_template Thu Oct 6 09:19:57 2005
@@ -231,30 +231,16 @@ providing a compreg-compatible method.
.sub _tcl_compile
.param string tcl_code
- .local pmc pir_compiler
- .local string pir_code
-
- .local pmc escaper
- escaper = find_global "Data::Escape", "String"
-
- pir_compiler = compreg "PIR"
-
.local pmc compiled_num
compiled_num = find_global "_Tcl", "compiled_num"
inc compiled_num
- pir_code = ".namespace [ \"_Tcl\" ]\n.sub _compiled_sub"
- $S0 = compiled_num
- pir_code .= $S0
- pir_code .= " :anon\n.local string code\ncode = \""
- tcl_code = escaper(tcl_code,"\"")
- pir_code .= tcl_code
- pir_code .= "\"\n.local pmc parse\n"
- pir_code .= "parse = find_global \"_Tcl\", \"parse\"\n"
- pir_code .= "$P1 = parse(code)\n.return $P1()\n.end\n"
+ .local pmc compiler,pir_compiler
+ compiler = find_global "_Tcl", "compile"
+ pir_compiler = find_global "_Tcl", "pir_compiler"
- $P1 = pir_compiler(pir_code)
- .return ($P1)
+ ($I0,$S0) = compiler(0,tcl_code)
+ .return pir_compiler($I0,$S0)
.end
${RULES}
