Author: coke
Date: Thu Oct 6 11:55:49 2005
New Revision: 9381
Modified:
trunk/languages/tcl/TODO
trunk/languages/tcl/lib/builtins/while.pir
trunk/languages/tcl/lib/commands/while.pir
Log:
[while] is now inlined.
Modified: trunk/languages/tcl/TODO
==============================================================================
--- trunk/languages/tcl/TODO (original)
+++ trunk/languages/tcl/TODO Thu Oct 6 11:55:49 2005
@@ -26,7 +26,7 @@ Generate compiler-variants for several b
commands like C<while>.
Modify the compiler for tclcommand to generate the inline version if
it's available. (C<proc> and C<expr> should also be straightforward, as they
-already compile anyway.) [Completed: incr, break, continue, for]
+already compile anyway.) [Completed: incr, break, continue, for, while]
Note: compiled builtins always take two args: the register_num to begin
using for the inlined code, and a single container pmc that contains the
Modified: trunk/languages/tcl/lib/builtins/while.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/while.pir (original)
+++ trunk/languages/tcl/lib/builtins/while.pir Thu Oct 6 11:55:49 2005
@@ -0,0 +1,70 @@
+.namespace [ "_Tcl::builtins" ]
+
+.sub "while"
+ .param int register_num
+ .param pmc argv
+
+ .local int argc
+ argc = argv
+ if argc != 2 goto badargs
+
+ .local string pir_code,loop_label,done_label,temp_code
+ .local int cond_num
+ $S0 = register_num
+ loop_label = "loop" . $S0
+ done_label = "done" . $S0
+
+ .local pmc cond,body,compiler,expr_compiler
+
+ compiler= find_global "_Tcl", "compile"
+ expr_compiler= find_global "_Tcl", "__expression_compile"
+
+ cond = argv[0]
+ body = argv[1]
+
+ pir_code .= loop_label
+ pir_code .= ":\n"
+
+ (cond_num, temp_code) = expr_compiler(register_num, cond)
+ register_num = cond_num + 1
+ pir_code .= temp_code
+
+ $P1 = new .Array
+ $P1 = 2
+ $P1[0] = cond_num
+ $P1[1] = done_label
+
+ sprintf temp_code, "unless $P%i goto %s\n", $P1
+
+ pir_code .= temp_code
+
+ (register_num,temp_code) = compiler(register_num, body)
+ pir_code .= temp_code
+ inc register_num
+
+ $S0=<<"END_PIR"
+goto %s
+%s:
+$P%i=new .TclString
+$P%i=\"\"
+END_PIR
+
+ $P1 = new Array
+ $P1 = 4
+ $P1[0] = loop_label
+ $P1[1] = done_label
+ $P1[2] = register_num
+ $P1[3] = register_num
+
+ temp_code = sprintf $S0, $P1
+ pir_code .= temp_code
+
+ .return(register_num,pir_code)
+
+badargs:
+ pir_code =<<"END_PIR"
+.throw('wrong # args: should be \"while test command\"')
+END_PIR
+
+ .return(register_num,pir_code)
+.end
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 11:55:49 2005
@@ -1,3 +1,5 @@
+# XXX convert to a call to the inline'd version
+
###
# [while]
