Author: coke
Date: Sat Jan 14 10:38:55 2006
New Revision: 11187
Modified:
trunk/languages/tcl/lib/builtins/eof.tmt
trunk/languages/tcl/lib/builtins/exit.tmt
trunk/languages/tcl/lib/builtins/incr.tmt
trunk/languages/tcl/lib/builtins/join.tmt
trunk/languages/tcl/lib/builtins/llength.tmt
trunk/languages/tcl/lib/builtins/pwd.tmt
trunk/languages/tcl/lib/builtins/time.tmt
trunk/languages/tcl/lib/builtins/while.tmt
trunk/languages/tcl/tools/gen_inline.pl
Log:
tcl -
o re-add break/continue support back into [while].
o remove outer braces from template syntax.
Modified: trunk/languages/tcl/lib/builtins/eof.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/eof.tmt (original)
+++ trunk/languages/tcl/lib/builtins/eof.tmt Sat Jan 14 10:38:55 2006
@@ -1,9 +1,9 @@
-{
- command => 'eof',
- usage => "channelId:channel",
- code => <<'END_PIR',
+command => 'eof',
+usage => "channelId:channel",
+code => <<'END_PIR'
+
$I{register_num} = isfalse $P{register_channelId}
$P{register_num} = new .TclInt
$P{register_num} = $I{register_num}
+
END_PIR
-}
Modified: trunk/languages/tcl/lib/builtins/exit.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/exit.tmt (original)
+++ trunk/languages/tcl/lib/builtins/exit.tmt Sat Jan 14 10:38:55 2006
@@ -1,8 +1,8 @@
-{
- command => 'exit',
- usage => "?returnCode:int=0?",
- code => <<'END_PIR',
+command => 'exit',
+usage => "?returnCode:int=0?",
+code => <<'END_PIR'
+
$I{register_returnCode} = $P{register_returnCode}
exit $I{register_returnCode}
+
END_PIR
-}
Modified: trunk/languages/tcl/lib/builtins/incr.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/incr.tmt (original)
+++ trunk/languages/tcl/lib/builtins/incr.tmt Sat Jan 14 10:38:55 2006
@@ -1,8 +1,7 @@
-{
- command => 'incr',
- usage=> "varName:var ?increment:int=1?",
- code => <<'END_PIR',
+command => 'incr',
+usage=> "varName:var ?increment:int=1?",
+code => <<'END_PIR'
+
$P{register_num} = $P{register_varName} + $P{register_increment}
__set($P{register_varName_varname},$P{register_num})
END_PIR
-}
Modified: trunk/languages/tcl/lib/builtins/join.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/join.tmt (original)
+++ trunk/languages/tcl/lib/builtins/join.tmt Sat Jan 14 10:38:55 2006
@@ -1,11 +1,9 @@
-{
- command => 'join',
- usage => "list:list ?joinString= ?",
- code => <<'END_PIR',
+command => 'join',
+usage => "list:list ?joinString= ?",
+code => <<'END_PIR'
$S{register_joinString} = $P{register_joinString}
$S{register_num} = join $S{register_joinString}, $P{register_list}
$P{register_num} = new .TclString
$P{register_num} = $S{register_num}
END_PIR
-}
Modified: trunk/languages/tcl/lib/builtins/llength.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/llength.tmt (original)
+++ trunk/languages/tcl/lib/builtins/llength.tmt Sat Jan 14 10:38:55 2006
@@ -1,10 +1,8 @@
-{
- command => 'llength',
- usage => "list:list",
- code => <<'END_PIR',
+command => 'llength',
+usage => "list:list",
+code => <<'END_PIR'
$I{register_num} = $P{register_list}
$P{register_num} = new .TclInt
$P{register_num} = $I{register_num}
END_PIR
-}
Modified: trunk/languages/tcl/lib/builtins/pwd.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/pwd.tmt (original)
+++ trunk/languages/tcl/lib/builtins/pwd.tmt Sat Jan 14 10:38:55 2006
@@ -1,7 +1,7 @@
-{
- command => 'pwd',
- code => <<'END_PIR',
+command => 'pwd',
+code => <<'END_PIR'
+
$P{register_num} = new .OS
$P{register_num} = $P{register_num}.'cwd'()
+
END_PIR
-}
Modified: trunk/languages/tcl/lib/builtins/time.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/time.tmt (original)
+++ trunk/languages/tcl/lib/builtins/time.tmt Sat Jan 14 10:38:55 2006
@@ -1,7 +1,7 @@
-{
- command => 'time',
- usage=> "script:script ?count:int=1?",
- code => <<'END_PIR',
+command => 'time',
+usage=> "script:script ?count:int=1?",
+code => <<'END_PIR'
+
$I0 = $P{register_count}
time_loop_{register_num}:
if $I0 == 0 goto time_{register_num}_done
@@ -19,5 +19,5 @@ $S{register_num} = $N{register_num}
$S{register_num} .= ' microseconds per iteration'
$P{register_num} = new .TclString
$P{register_num} = $S{register_num}
+
END_PIR
-}
Modified: trunk/languages/tcl/lib/builtins/while.tmt
==============================================================================
--- trunk/languages/tcl/lib/builtins/while.tmt (original)
+++ trunk/languages/tcl/lib/builtins/while.tmt Sat Jan 14 10:38:55 2006
@@ -1,16 +1,23 @@
-{
- command => 'while',
- usage=> "test:expr command:script",
- code => <<'END_PIR'
+command => 'while',
+usage => "test:expr command:script",
+code => <<'END_PIR'
while_loop_{register_command}:
{register_test_code}
$I{register_test} = $P{register_test}
unless $I{register_test} goto while_loop_done_{register_command}
-{register_command_code}
+push_eh while_loop_exception_{register_command}
+ {register_command_code}
+clear_eh
goto while_loop_{register_command}
+while_loop_exception_{register_command}:
+ .catch()
+ .get_return_code($I{register_test})
+ if $I{register_test} == TCL_CONTINUE goto while_loop_{register_command}
+ if $I{register_test} == TCL_BREAK goto while_loop_done_{register_command}
+ .rethrow()
+
while_loop_done_{register_command}:
END_PIR
-}
Modified: trunk/languages/tcl/tools/gen_inline.pl
==============================================================================
--- trunk/languages/tcl/tools/gen_inline.pl (original)
+++ trunk/languages/tcl/tools/gen_inline.pl Sat Jan 14 10:38:55 2006
@@ -76,7 +76,7 @@ eventually be compiled (C<INLINED>).
$contents = <$handle>;
my $code = "\$template = $contents";
-eval "\$template = $contents"; # ewww...
+eval "\$template = { $contents }"; # ewww...
die "error processing $file: $@" if ($@);
add_wrapped(<<END_PIR);
