Author: coke
Date: Wed Nov 2 07:20:47 2005
New Revision: 9708
Modified:
trunk/languages/tcl/lib/parser.pir
trunk/languages/tcl/lib/returncodes.pir
trunk/languages/tcl/lib/tclbinaryops.pir
trunk/languages/tcl/lib/tclcommand.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
Log:
Fix :optional init bug.
Add a .cloneable() macro that allows us to easily implement __clone
on a class.
Modified: trunk/languages/tcl/lib/parser.pir
==============================================================================
--- trunk/languages/tcl/lib/parser.pir (original)
+++ trunk/languages/tcl/lib/parser.pir Wed Nov 2 07:20:47 2005
@@ -113,7 +113,13 @@ use by the generated PIR.
.sub pir_compiler
.param int result_reg
.param string pir_code
- .param int code_only :optional
+ .param int code_only :optional
+ .param int has_code_only :opt_flag
+
+ if has_code_only goto done_init
+ code_only = 0
+
+done_init:
.local pmc compiled_num
compiled_num = find_global "_Tcl", "compiled_num"
Modified: trunk/languages/tcl/lib/returncodes.pir
==============================================================================
--- trunk/languages/tcl/lib/returncodes.pir (original)
+++ trunk/languages/tcl/lib/returncodes.pir Wed Nov 2 07:20:47 2005
@@ -76,3 +76,16 @@ of sorts to the exceptions.
e[VALUE_SLOT] = .value
throw e
.endm
+
+# Utility methods: the implementation of these never change:
+# define them once and just include them.
+
+.macro cloneable ()
+.sub __clone :method
+ .sym pmc obj
+ $I0 = typeof self
+ obj = new $I0
+ obj = self
+ .return(obj)
+.end
+.endm
Modified: trunk/languages/tcl/lib/tclbinaryops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclbinaryops.pir (original)
+++ trunk/languages/tcl/lib/tclbinaryops.pir Wed Nov 2 07:20:47 2005
@@ -1,8 +1,10 @@
+.include "languages/tcl/lib/returncodes.pir"
+
.namespace [ "TclBinaryOp" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
.const int OPERATOR_AND = 26
.const int OPERATOR_OR = 27
@@ -113,14 +115,6 @@ Initialize the attributes for an instanc
setattribute self, "TclBinaryOp\x00r_operand", $P0
.end
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
-
.sub compile :method
.param int register_num
Modified: trunk/languages/tcl/lib/tclcommand.pir
==============================================================================
--- trunk/languages/tcl/lib/tclcommand.pir (original)
+++ trunk/languages/tcl/lib/tclcommand.pir Wed Nov 2 07:20:47 2005
@@ -1,8 +1,10 @@
+.include "languages/tcl/lib/returncodes.pir"
+
.namespace [ "TclCommand" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
=head2 __class_init
@@ -16,25 +18,6 @@ Define the attributes required for the c
addattribute $P1, "name"
.end
-=head2 __init
-
-Initialize the attributes for an instance of the class
-
-=cut
-
-.sub __init :method
- #$P0 = new .TclString
- #setattribute self, "TclCommand\x00name", $P0
-.end
-
-
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
=head2 interpret
Modified: trunk/languages/tcl/lib/tclcommandlist.pir
==============================================================================
--- trunk/languages/tcl/lib/tclcommandlist.pir (original)
+++ trunk/languages/tcl/lib/tclcommandlist.pir Wed Nov 2 07:20:47 2005
@@ -1,8 +1,10 @@
+.include "languages/tcl/lib/returncodes.pir"
+
.namespace [ "TclCommandList" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
.sub __class_init :load
$P0 = getclass "TclList"
@@ -35,11 +37,3 @@ done:
.return (register_num, pir_code)
.end
-
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
Modified: trunk/languages/tcl/lib/tclconst.pir
==============================================================================
--- trunk/languages/tcl/lib/tclconst.pir (original)
+++ trunk/languages/tcl/lib/tclconst.pir Wed Nov 2 07:20:47 2005
@@ -1,8 +1,10 @@
+.include "languages/tcl/lib/returncodes.pir"
+
.namespace [ "TclConst" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
=head2 __class_init
@@ -53,14 +55,6 @@ Define the attributes required for the c
.end
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
-
.sub __set_string_native :method
.param string value
Modified: trunk/languages/tcl/lib/tclfunc.pir
==============================================================================
--- trunk/languages/tcl/lib/tclfunc.pir (original)
+++ trunk/languages/tcl/lib/tclfunc.pir Wed Nov 2 07:20:47 2005
@@ -1,8 +1,10 @@
+.include "languages/tcl/lib/returncodes.pir"
+
.namespace [ "TclFunc" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
# functions
.const int FUNCTION_ABS = 53
@@ -176,12 +178,3 @@ done_all:
.return(register_num,pir_code)
.end
-
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
-
Modified: trunk/languages/tcl/lib/tclops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclops.pir (original)
+++ trunk/languages/tcl/lib/tclops.pir Wed Nov 2 07:20:47 2005
@@ -1,8 +1,10 @@
+.include "languages/tcl/lib/returncodes.pir"
+
.namespace [ "TclUnaryOp" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
=head2 __class_init
@@ -82,12 +84,3 @@ done:
.return(register_num, pir_code)
.end
-
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
-
Modified: trunk/languages/tcl/lib/tclvar.pir
==============================================================================
--- trunk/languages/tcl/lib/tclvar.pir (original)
+++ trunk/languages/tcl/lib/tclvar.pir Wed Nov 2 07:20:47 2005
@@ -1,8 +1,10 @@
+.include "languages/tcl/lib/returncodes.pir"
+
.namespace [ "TclVar" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
=head2 __class_init
@@ -33,12 +35,3 @@ Define the attributes required for the c
.return (register_num,pir_code)
.end
-
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
-
Modified: trunk/languages/tcl/lib/tclword.pir
==============================================================================
--- trunk/languages/tcl/lib/tclword.pir (original)
+++ trunk/languages/tcl/lib/tclword.pir Wed Nov 2 07:20:47 2005
@@ -1,12 +1,10 @@
-=head1 TclWord
-
-=cut
+.include "languages/tcl/lib/returncodes.pir"
.namespace [ "TclWord" ]
.HLL "Tcl", "tcl_group"
-.include "languages/tcl/lib/returncodes.pir"
+.cloneable()
=head1 Methods
@@ -83,12 +81,3 @@ concat_loop_done:
.return(register_num,pir_code)
.end
-
-.sub __clone :method
- .local pmc obj
- $I0 = typeof self
- obj = new $I0
- obj = self
- .return(obj)
-.end
-
