Author: coke
Date: Tue Apr 19 16:51:10 2005
New Revision: 7886
Removed:
trunk/languages/tcl/lib/macros/boolean.imc
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles/tcl.in
trunk/config/gen/makefiles/tcl_examples.in
trunk/dynclasses/tclstring.pmc
trunk/languages/tcl/lib/commands/if.imc
trunk/languages/tcl/lib/commands/while.imc
Log:
Remove "boolean" macro - truth is now tested for in the PMC itself. Cleanup
another GC bug that existed in tclstring.pmc
Provide a simple way to invoke the ``interactive'' tclsh.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Tue Apr 19 16:51:10 2005
@@ -50,7 +50,6 @@
charset/unicode.h []
classes/array.pmc []
classes/bigint.pmc []
-classes/boolean.pmc []
classes/bound_nci.pmc []
classes/closure.pmc []
classes/complex.pmc []
Modified: trunk/config/gen/makefiles/tcl.in
==============================================================================
--- trunk/config/gen/makefiles/tcl.in (original)
+++ trunk/config/gen/makefiles/tcl.in Tue Apr 19 16:51:10 2005
@@ -47,7 +47,6 @@
lib${slash}get_var.imc \
lib${slash}interpret.imc \
lib${slash}list.imc \
-lib${slash}macros${slash}boolean.imc \
lib${slash}macros${slash}is_space.imc \
lib${slash}string_to_list.imc \
tcl.imc_template \
@@ -65,6 +64,9 @@
lib${slash}tclword.pbc: lib${slash}tclword.imc
(cd $(RELPATH) && $(PARROT) --output=$(LIBPATH)tclword.pbc
$(LIBPATH)tclword.imc)
+tclsh: tcl.pbc
+ (cd $(RELPATH) && $(PARROT) --gc-debug $(MYPATH)tcl.pbc)
+
test: tcl.pbc
$(PERL) t/harness
Modified: trunk/config/gen/makefiles/tcl_examples.in
==============================================================================
--- trunk/config/gen/makefiles/tcl_examples.in (original)
+++ trunk/config/gen/makefiles/tcl_examples.in Tue Apr 19 16:51:10 2005
@@ -4,10 +4,14 @@
default:
@echo "to run <foo>.tcl, type 'make <foo>'"
+ @echo "to run an interactive tclsh, type 'make tclsh'"
%:%.tcl
cd $(UP_PATH) && $(PARROT) --gc-debug $(DOWN_PATH)tcl.pbc
$(DOWN_PATH)[EMAIL PROTECTED]
+tclsh:
+ cd $(UP_PATH) && $(PARROT) --gc-debug $(DOWN_PATH)tcl.pbc
+
# (for development testing)
test:
cd $(UP_PATH) && $(PARROT) -t $(DOWN_PATH)tcl.pbc
$(DOWN_PATH)examples${slash}foo.tcl
Modified: trunk/dynclasses/tclstring.pmc
==============================================================================
--- trunk/dynclasses/tclstring.pmc (original)
+++ trunk/dynclasses/tclstring.pmc Tue Apr 19 16:51:10 2005
@@ -21,6 +21,8 @@
pmclass TclString extends TclObject dynpmc group tcl_group {
void class_init () {
+ PMC *string_anchor;
+ INTVAL fixedstringarray_typenum;
if (pass) {
dynclass_TclString = Parrot_PMC_typenum(INTERP,"TclString");
dynclass_TclInt = Parrot_PMC_typenum(INTERP,"TclInt");
@@ -29,6 +31,14 @@
false = string_from_const_cstring(INTERP, "false",5);
yes = string_from_const_cstring(INTERP, "yes",3);
no = string_from_const_cstring(INTERP, "no",2);
+ fixedstringarray_typenum =
+ Parrot_PMC_typenum(INTERP, "FixedStringArray");
+ string_anchor = pmc_new(INTERP,fixedstringarray_typenum);
+ VTABLE_set_integer_native(INTERP,string_anchor,4);
+ VTABLE_set_string_keyed_int(INTERP,string_anchor,0,true);
+ VTABLE_set_string_keyed_int(INTERP,string_anchor,1,false);
+ VTABLE_set_string_keyed_int(INTERP,string_anchor,2,yes);
+ VTABLE_set_string_keyed_int(INTERP,string_anchor,3,no);
}
}
Modified: trunk/languages/tcl/lib/commands/if.imc
==============================================================================
--- trunk/languages/tcl/lib/commands/if.imc (original)
+++ trunk/languages/tcl/lib/commands/if.imc Tue Apr 19 16:51:10 2005
@@ -72,9 +72,7 @@
(return_type,retval) = expression_i(retval)
if return_type == TCL_ERROR goto done_final
- .boolean(retval,$I0)
-
- if $I0 == 0 goto do_elseifs
+ unless retval goto do_elseifs
code = body
goto done
@@ -90,8 +88,7 @@
if return_type == TCL_ERROR goto done_final
(return_type,retval) = expression_i(retval)
if return_type == TCL_ERROR goto done_final
- .boolean(retval,$I0)
- if $I0 == 1 goto done_elseifs
+ if retval goto done_elseifs
inc $I2
goto elseif_loop
Modified: trunk/languages/tcl/lib/commands/while.imc
==============================================================================
--- trunk/languages/tcl/lib/commands/while.imc (original)
+++ trunk/languages/tcl/lib/commands/while.imc Tue Apr 19 16:51:10 2005
@@ -33,8 +33,7 @@
if return_type == TCL_ERROR goto done_done
(return_type,retval) = expression_i(retval)
if return_type == TCL_ERROR goto done_done
- .boolean(retval,$I0)
- if $I0 == 0 goto done
+ unless retval goto done
(return_type,retval) = interpret(parsed_code)
if return_type == TCL_BREAK goto done
if return_type == TCL_RETURN goto done
