Author: coke
Date: Wed Oct 5 08:36:22 2005
New Revision: 9357
Modified:
trunk/languages/tcl/TODO
trunk/languages/tcl/docs/howto.pod
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/parser.pir
trunk/languages/tcl/lib/returncodes.pir
trunk/languages/tcl/lib/tclbinaryops.pir
trunk/languages/tcl/lib/tclcommandlist.pir
trunk/languages/tcl/lib/tclconst.pir
trunk/languages/tcl/lib/tclfunc.pir
trunk/languages/tcl/lib/tclops.pir
trunk/languages/tcl/lib/tclvar.pir
trunk/languages/tcl/lib/tclword.pir
trunk/languages/tcl/tcl.pir_template
trunk/languages/tcl/tcl.pl
Log:
Take advantage of the new heredoc syntax
Remove some dead code
Add some more docs.
Modified: trunk/languages/tcl/TODO
==============================================================================
--- trunk/languages/tcl/TODO (original)
+++ trunk/languages/tcl/TODO Wed Oct 5 08:36:22 2005
@@ -17,15 +17,16 @@ with a few caveats and TODOs.
=item 0
-Remove all the (now) dead "interpret" code.
+Add the "unknown command" logic from the (commented out) tclcommand's interpret
+to the compiled version, and then remove the interpret :method.
=item 1
Generate compiler-variants for several builtins, esp. the flow control
-commands like C<while>. Easy ones like C<incr> should be done as well.
+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.)
+already compile anyway.) [Completed: incr, break, continue]
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/docs/howto.pod
==============================================================================
--- trunk/languages/tcl/docs/howto.pod (original)
+++ trunk/languages/tcl/docs/howto.pod Wed Oct 5 08:36:22 2005
@@ -12,34 +12,24 @@ should merge with the TODO to avoid redu
=over 4
-=item interperter -> compiler
+=item compiler bits
-Right now, partcl is an interpreter. The parser generates an AST of sorts,
-which the interpreter then walks through the ast, finds the command to execute,
-(e.g., C<Tcl::puts>), gets the values for each of the args (Evaluation is
-deferred until just before the function is called.)
-
-To switch to a compiler, we need to basically use the same interpreter loop,
-but generate it specifically for the series of commands being invoked. Once
-we have the PIR, we can then C<compile> it, and return that anonymous PIR
-sub. Then, instead of calling "interpret", we can just invoke that sub.
-
-Some optimizations we can do:
-
-TclWord (which we call to get the PMC for
-the various arguments), has an "is_const" method - If we look up the
-value and it's constant, we can hardcode it right into the PIR. Same goes
-for the commands.
-
-A non-tcl option we can provide is a command line option to just dump the
-generated PIR/bytecode. (e.g. tclsh -o foo.pir or tclsh -o foo.pbc)
-
-One algorithm to cache the builtins - keep a global counter (in some places,
-called epoch) - every time [rename] is called, epoch is bumped up and we have
-to re-fetch the method. But, if it hasn't changed, we're allowed to cheat.
-And if we can cheat on something like C<puts foo>, we can translate that
-*in place* to a simple C<print "foo\n"> and not have to go through all
-the overhead.
+Partcl is now a compiler. Given a section of tcl code, it generates PIR
+instead of an AST, then compiles and invokes the sub.
+
+When writing a new builtin, preferentially put it in
+C<< lib/builtins/<builtin>.pir >> , and write a wrapper in
+C<< lib/commands/<builtin>.pir >> which calls the inlined version.
+
+Inlined builtins must take a register num to begin with, along with a single
+PMC with the various args. (As opposed to the interpreted-style, which takes
+a vararg list.). They must return the register in which the result of the
+command is stored, along with the generated PIR. The results of calling
+the inlined code will be used by C<lib/tclcommand.pir>. The inlined code
+is further wrapped in a protective conditional which will (eventually) skip
+the inlined version if it can no longer be trusted, and will fall back to
+the interpreted version as necessary. (And throw an exception if the command
+is not found at runtime.)
=item speed
Modified: trunk/languages/tcl/lib/builtins/break.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/break.pir (original)
+++ trunk/languages/tcl/lib/builtins/break.pir Wed Oct 5 08:36:22 2005
@@ -14,6 +14,9 @@
.return(register_num,pir_code)
badargs:
- pir_code = ".throw(\"wrong # args: should be \\\"break\\\"\")\n"
+ pir_code =<<"END_PIR"
+.throw(\"wrong # args: should be \\\"break\\\"\")
+END_PIR
+
.return(register_num,pir_code)
.end
Modified: trunk/languages/tcl/lib/builtins/continue.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/continue.pir (original)
+++ trunk/languages/tcl/lib/builtins/continue.pir Wed Oct 5 08:36:22 2005
@@ -14,6 +14,9 @@
.return(register_num,pir_code)
badargs:
- pir_code = ".throw(\"wrong # args: should be \\\"continue\\\"\")\n"
+ pir_code =<<"END_PIR"
+.throw(\"wrong # args: should be \\\"continue\\\"\")
+END_PIR
+
.return(register_num,pir_code)
.end
Modified: trunk/languages/tcl/lib/builtins/incr.pir
==============================================================================
--- trunk/languages/tcl/lib/builtins/incr.pir (original)
+++ trunk/languages/tcl/lib/builtins/incr.pir Wed Oct 5 08:36:22 2005
@@ -100,6 +100,9 @@ got_increment:
.return (register_num,pir_code)
error:
- pir_code = ".throw (\"wrong # args: should be \\\"incr varName
?increment?\\\"\")\n"
+ pir_code =<<"END_PIR"
+.throw (\"wrong # args: should be \\\"incr varName ?increment?\\\"\")
+END_PIR
+
.return (register_num,pir_code)
.end
Modified: trunk/languages/tcl/lib/parser.pir
==============================================================================
--- trunk/languages/tcl/lib/parser.pir (original)
+++ trunk/languages/tcl/lib/parser.pir Wed Oct 5 08:36:22 2005
@@ -655,7 +655,7 @@ stringish:
$P1 = find_global "Data::Escape", "String"
thing = $P1(thing,"\"")
- lquote = "\"" # might eventually put unicode: here.
+ lquote = "\"" # XXX might eventually put unicode: here.
rquote = "\""
set_args:
Modified: trunk/languages/tcl/lib/returncodes.pir
==============================================================================
--- trunk/languages/tcl/lib/returncodes.pir (original)
+++ trunk/languages/tcl/lib/returncodes.pir Wed Oct 5 08:36:22 2005
@@ -12,11 +12,11 @@ A convenience: we need these return code
# values for accessing exception information
.const int VALUE_SLOT = 0 # _message
- .const int CODE_SLOT = 9 # tcl return code.
+ .const int CODE_SLOT = 9 # tcl return code.
=head1 exception handling macros
-Exceptions creation can be fairly verbose. These macros provide an API
+Exception creation can be fairly verbose. These macros provide an API
of sorts to the exceptions.
=cut
Modified: trunk/languages/tcl/lib/tclbinaryops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclbinaryops.pir (original)
+++ trunk/languages/tcl/lib/tclbinaryops.pir Wed Oct 5 08:36:22 2005
@@ -181,17 +181,59 @@ op_shl:
op_shr:
.binary_op("$P%i = shr $P%i, $P%i\n")
op_lt:
- .binary_op2 ("$I%i = islt $P%i, $P%i\n$P%i = new .TclInt\n$P%i= $I%i\n")
+
+ $S0 = <<"END_PIR"
+$I%i=islt $P%i,$P%i
+$P%i=new .TclInt
+$P%i= $I%i
+END_PIR
+
+ .binary_op2 ($S0)
op_gt:
- .binary_op2 ("$I%i = isgt $P%i, $P%i\n$P%i = new .TclInt\n$P%i= $I%i\n")
+
+ $S0 = <<"END_PIR"
+$I%i=isgt $P%i,$P%i
+$P%i=new .TclInt
+$P%i= $I%i
+END_PIR
+
+ .binary_op2 ($S0)
op_lte:
- .binary_op2 ("$I%i = isle $P%i, $P%i\n$P%i = new .TclInt\n$P%i= $I%i\n")
+
+ $S0 = <<"END_PIR"
+$I%i=isle $P%i,$P%i
+$P%i=new .TclInt
+$P%i= $I%i
+END_PIR
+
+ .binary_op2 ($S0)
op_gte:
- .binary_op2 ("$I%i = isge $P%i, $P%i\n$P%i = new .TclInt\n$P%i= $I%i\n")
+
+ $S0 = <<"END_PIR"
+$I%i=isge $P%i,$P%i
+$P%i=new .TclInt
+$P%i= $I%i
+END_PIR
+
+ .binary_op2 ($S0)
op_equal:
- .binary_op2 ("$I%i = iseq $P%i, $P%i\n$P%i = new .TclInt\n$P%i= $I%i\n")
+
+ $S0 = <<"END_PIR"
+$I%i=iseq $P%i,$P%i
+$P%i=new .TclInt
+$P%i= $I%i
+END_PIR
+
+ .binary_op2 ($S0)
op_unequal:
- .binary_op2 ("$I%i = isne $P%i, $P%i\n$P%i = new .TclInt\n$P%i= $I%i\n")
+
+ $S0 = <<"END_PIR"
+$I%i=isne $P%i,$P%i
+$P%i=new .TclInt
+$P%i= $I%i
+END_PIR
+
+ .binary_op2 ($S0)
op_bitand:
.binary_op("$P%i = band $P%i, $P%i\n")
op_bitxor:
@@ -199,9 +241,27 @@ op_bitxor:
op_bitor:
.binary_op("$P%i = bor $P%i, $P%i\n")
op_ne:
- .binary_op3("$S%i=$P%i\n$S%i=$P%i\n$I%i = isne $S%i, $S%i\n$P%i = new
.TclInt\n$P%i = $I%i\n")
+
+ $S0 = <<"END_PIR"
+$S%i=$P%i
+$S%i=$P%i
+$I%i=isne $S%i,$S%i
+$P%i=new .TclInt
+$P%i=$I%i
+END_PIR
+
+ .binary_op3($S0)
op_eq:
- .binary_op3("$S%i=$P%i\n$S%i=$P%i\n$I%i = iseq $S%i, $S%i\n$P%i = new
.TclInt\n$P%i = $I%i\n")
+
+ $S0 = <<"END_PIR"
+$S%i=$P%i
+$S%i=$P%i
+$I%i=iseq $S%i,$S%i
+$P%i=new .TclInt
+$P%i=$I%i
+END_PIR
+
+ .binary_op3($S0)
op_and:
inc register_num
.local int jump_label
@@ -226,21 +286,23 @@ op_and:
printf_args[12] = register_num
printf_args[13] = jump_label
- pir_code .= "%s"
- pir_code .= "unless $P%i goto false%i\n"
- pir_code .= "%s"
- pir_code .= "unless $P%i goto false%i\n"
- pir_code .= "true%i:\n"
- pir_code .= "$P%i = new .TclInt\n"
- pir_code .= "$P%i = 1\n"
- pir_code .= "goto done%i\n"
- pir_code .= "false%i:\n"
- pir_code .= "$P%i = new .TclInt\n"
- pir_code .= "$P%i = 0\n"
- pir_code .= "done%i:\n"
-
- pir_code = sprintf pir_code, printf_args
+ $S0 = <<"END_PIR"
+%s
+unless $P%i goto false%i
+%s
+unless $P%i goto false%i
+true%i:
+$P%i=new .TclInt
+$P%i=1
+goto done%i
+false%i:
+$P%i=new .TclInt
+$P%i=0
+done%i:
+END_PIR
+ $S1 = sprintf $S0, printf_args
+ pir_code .= $S1
goto done
op_or:
@@ -267,20 +329,23 @@ op_or:
printf_args[12] = register_num
printf_args[13] = jump_label
- pir_code .= "%s"
- pir_code .= "if $P%i goto true%i\n"
- pir_code .= "%s"
- pir_code .= "if $P%i goto true%i\n"
- pir_code .= "false%i:\n"
- pir_code .= "$P%i = new .TclInt\n"
- pir_code .= "$P%i = 0\n"
- pir_code .= "goto done%i\n"
- pir_code .= "true%i:\n"
- pir_code .= "$P%i = new .TclInt\n"
- pir_code .= "$P%i = 1\n"
- pir_code .= "done%i:\n"
+ $S0 =<<"END_PIR"
+%s
+if $P%i goto true%i
+%s
+if $P%i goto true%i
+false%i:
+$P%i=new .TclInt
+$P%i=0\
+goto done%i
+true%i:
+$P%i=new .TclInt
+$P%i=1
+done%i:
+END_PIR
- pir_code = sprintf pir_code, printf_args
+ $S1 = sprintf $S0, printf_args
+ pir_code .= $S1
done:
Modified: trunk/languages/tcl/lib/tclcommandlist.pir
==============================================================================
--- trunk/languages/tcl/lib/tclcommandlist.pir (original)
+++ trunk/languages/tcl/lib/tclcommandlist.pir Wed Oct 5 08:36:22 2005
@@ -9,27 +9,6 @@
$P0 = subclass $P0, "TclCommandList"
.end
-=for cut
-
-.sub interpret :method
- .local pmc retval
- .local int i, elems
- elems = self
- i = 0
-
-loop:
- if i == elems goto done
- $P0 = self[i]
- retval = $P0."interpret"()
- inc i
- goto loop
-done:
- .return (retval)
-
-.end
-
-=cut
-
.sub compile :method
.param int register_num
Modified: trunk/languages/tcl/lib/tclconst.pir
==============================================================================
--- trunk/languages/tcl/lib/tclconst.pir (original)
+++ trunk/languages/tcl/lib/tclconst.pir Wed Oct 5 08:36:22 2005
@@ -257,17 +257,6 @@ done:
$P0 = value
.end
-=head2 interpret
-
-Get the value of the const.
-
-
-.sub interpret :method
- .return(self)
-.end
-
-=cut
-
=head2 compile
Generate PIR code which can be used to generate our value
Modified: trunk/languages/tcl/lib/tclfunc.pir
==============================================================================
--- trunk/languages/tcl/lib/tclfunc.pir (original)
+++ trunk/languages/tcl/lib/tclfunc.pir Wed Oct 5 08:36:22 2005
@@ -163,11 +163,12 @@ done:
printf_args[6] = register_num
printf_args[7] = register_num
- pir_code .= "$N%i=$P%i\n"
- pir_code .= "$N%i=%s $N%i\n"
- pir_code .= "$P%i = new .TclFloat\n"
- pir_code .= "$P%i=$N%i\n"
-
+ pir_code .= <<"END_PIR"
+$N%i=$P%i
+$N%i=%s $N%i
+$P%i=new .TclFloat
+$P%i=$N%i
+END_PIR
done_all:
Modified: trunk/languages/tcl/lib/tclops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclops.pir (original)
+++ trunk/languages/tcl/lib/tclops.pir Wed Oct 5 08:36:22 2005
@@ -29,44 +29,6 @@ Initialize the attributes for an instanc
setattribute self, "TclUnaryOp\x00operand", $P0
.end
-=for cut
-
-.sub interpret :method
- .local pmc retval
- retval = new TclInt
-
- .local pmc name, operand
- name = getattribute self, "TclUnaryOp\x00name"
- operand = getattribute self, "TclUnaryOp\x00operand"
- retval = operand."interpret"()
-
- operand = retval
-
- if name == "-" goto minus
- if name == "+" goto plus
- if name == "~" goto bitwise_not
- if name == "!" goto logical_not
-
-minus:
- retval = neg operand
- goto done
-plus:
- retval = operand
- goto done
-bitwise_not:
- retval = bnot operand
- goto done
-logical_not:
- retval = not operand
- goto done
-
-done:
- .return(retval)
-
-.end
-
-=cut
-
.sub compile :method
.param int register_num
Modified: trunk/languages/tcl/lib/tclvar.pir
==============================================================================
--- trunk/languages/tcl/lib/tclvar.pir (original)
+++ trunk/languages/tcl/lib/tclvar.pir Wed Oct 5 08:36:22 2005
@@ -15,20 +15,6 @@ Define the attributes required for the c
$P1 = subclass $P0, "TclVar"
.end
-=head2 interpret
-
-Get the value of the variable.
-
-
-.sub interpret :method
- .local pmc read
- read = find_global "_Tcl", "__read"
- $S0 = self
- .return read($S0)
-.end
-
-=cut
-
.sub compile :method
.param int register_num
Modified: trunk/languages/tcl/lib/tclword.pir
==============================================================================
--- trunk/languages/tcl/lib/tclword.pir (original)
+++ trunk/languages/tcl/lib/tclword.pir Wed Oct 5 08:36:22 2005
@@ -23,41 +23,6 @@ Define the attributes required for the c
$P1 = subclass $P0, "TclWord"
.end
-=head2 interpret
-
-Return a PMC that contains the value of our word, concatenating
-the string values of the elements.
-
-
-.sub interpret :method
- .local pmc retval
-
- .local int i, len
- i = 0
- len = self
-
- .local string word
- word = ""
-
-loop:
- if i == len goto loop_done
-
- $P0 = self[i]
- retval = $P0."interpret"()
-
- $S0 = retval
- word .= $S0
-
- inc i
- goto loop
-
-loop_done:
- .return(word)
-
-.end
-
-=cut
-
.sub compile :method
.param int register_num
Modified: trunk/languages/tcl/tcl.pir_template
==============================================================================
--- trunk/languages/tcl/tcl.pir_template (original)
+++ trunk/languages/tcl/tcl.pir_template Wed Oct 5 08:36:22 2005
@@ -81,6 +81,7 @@ providing a compreg-compatible method.
.sub __prepare_lib :load :anon
# Load any dependant libraries.
+ load_bytecode "languages/tcl/lib/tclbinaryops.pbc"
load_bytecode "languages/tcl/lib/tclcommand.pbc"
load_bytecode "languages/tcl/lib/tclcommandlist.pbc"
load_bytecode "languages/tcl/lib/tclconst.pbc"
Modified: trunk/languages/tcl/tcl.pl
==============================================================================
--- trunk/languages/tcl/tcl.pl (original)
+++ trunk/languages/tcl/tcl.pl Wed Oct 5 08:36:22 2005
@@ -39,7 +39,7 @@ my @commands = grep {s/\.pir$//} @cmd_fi
my $lib_dir = "lib";
opendir(LIBDIR,$lib_dir) or die;
-my @libs = map {"$lib_dir/$_"} grep {m/\.pir$/} grep {!
m/^tcl(lib|command|commandlist|const|func|ops|var|word).pir$/} readdir(LIBDIR);
+my @libs = map {"$lib_dir/$_"} grep {m/\.pir$/} grep {!
m/^tcl(lib|command|commandlist|const|func|ops|binaryops|var|word).pir$/}
readdir(LIBDIR);
closedir(LIBDIR);
my $includes;
