Author: leo
Date: Wed Jul 13 11:45:13 2005
New Revision: 8618
Modified:
branches/leo-ctx5/io/io.c
branches/leo-ctx5/io/io_buf.c
branches/leo-ctx5/languages/tcl/lib/commands/catch.imc
branches/leo-ctx5/languages/tcl/lib/commands/eval.imc
branches/leo-ctx5/languages/tcl/lib/commands/for.imc
branches/leo-ctx5/languages/tcl/lib/commands/foreach.imc
branches/leo-ctx5/languages/tcl/lib/commands/if.imc
branches/leo-ctx5/languages/tcl/lib/commands/proc.imc
branches/leo-ctx5/languages/tcl/lib/commands/set.imc
branches/leo-ctx5/languages/tcl/lib/commands/source.imc
branches/leo-ctx5/languages/tcl/lib/commands/time.imc
branches/leo-ctx5/languages/tcl/lib/commands/while.imc
branches/leo-ctx5/languages/tcl/lib/string_to_list.imc
branches/leo-ctx5/languages/tcl/lib/tclword.imc
branches/leo-ctx5/languages/tcl/t/harness
branches/leo-ctx5/languages/tcl/tcl.imc
Log:
merge -r8612:8617 from trunk
Modified: branches/leo-ctx5/io/io.c
==============================================================================
--- branches/leo-ctx5/io/io.c (original)
+++ branches/leo-ctx5/io/io.c Wed Jul 13 11:45:13 2005
@@ -98,30 +98,19 @@ gets allocated.
*/
STRING *
-PIO_make_io_string(Interp *interpreter, STRING **buf, size_t default_len)
+PIO_make_io_string(Interp *interpreter, STRING **buf, size_t len)
{
- size_t len;
STRING *s;
/*
* when we get a NULL string, we read a default len
*/
if (*buf == NULL) {
- *buf = new_string_header(interpreter, 0);
- (*buf)->bufused = default_len;
+ *buf = string_make_empty(interpreter, enum_stringrep_one, len);
+ return *buf;
}
s = *buf;
- len = s->bufused;
- if (!s->strstart && len) {
- PObj_bufstart(s) = s->strstart = mem_sys_allocate(len);
- PObj_buflen(s) = len;
- PObj_sysmem_SET(s);
- PObj_external_SET(s);
- s->charset = Parrot_iso_8859_1_charset_ptr;
- s->encoding = Parrot_fixed_8_encoding_ptr;
- /*
- * TODO encoding = raw
- */
- }
+ if (s->bufused < len)
+ Parrot_allocate_string(interpreter, s, len);
return s;
}
@@ -839,7 +828,7 @@ PIO_reads(theINTERP, PMC *pmc, size_t le
res->encoding = Parrot_fixed_8_encoding_ptr;
}
else
- res = PIO_make_io_string(interpreter, &res, len );
+ res = PIO_make_io_string(interpreter, &res, len);
res->bufused = len;
PIO_read_down(interpreter, l, io, &res);
Modified: branches/leo-ctx5/io/io_buf.c
==============================================================================
--- branches/leo-ctx5/io/io_buf.c (original)
+++ branches/leo-ctx5/io/io_buf.c Wed Jul 13 11:45:13 2005
@@ -551,14 +551,12 @@ PIO_buf_readline(theINTERP, ParrotIOLaye
ParrotIOBuf *b = &io->b;
size_t len;
STRING *s;
- int may_realloc;
if (*buf == NULL) {
*buf = new_string_header(interpreter, 0);
}
s = *buf;
s->strlen = 0;
- may_realloc = s->strstart == NULL;
/* fill empty buffer */
if (!(b->flags & PIO_BF_READBUF)) {
@@ -581,17 +579,11 @@ PIO_buf_readline(theINTERP, ParrotIOLaye
if (b->next == b->endb) {
len = b->endb - buf_start;
if (s->bufused < l) {
- if (may_realloc) {
- s->charset = Parrot_iso_8859_1_charset_ptr;
- s->encoding = Parrot_fixed_8_encoding_ptr;
- if (s->strstart) {
- Parrot_reallocate_string(interpreter, s, l);
- } else {
- Parrot_allocate_string(interpreter, s, l);
- }
+ if (s->strstart) {
+ Parrot_reallocate_string(interpreter, s, l);
+ } else {
+ Parrot_allocate_string(interpreter, s, l);
}
- else
- internal_exception(1, "readline: buffer too short");
}
out_buf = (unsigned char*)s->strstart + s->strlen;
memcpy(out_buf, buf_start, len);
@@ -602,17 +594,11 @@ PIO_buf_readline(theINTERP, ParrotIOLaye
}
}
if (s->bufused < l) {
- if (may_realloc) {
- s->charset = Parrot_iso_8859_1_charset_ptr;
- s->encoding = Parrot_fixed_8_encoding_ptr;
- if (s->strstart) {
- Parrot_reallocate_string(interpreter, s, l);
- } else {
- Parrot_allocate_string(interpreter, s, l);
- }
+ if (s->strstart) {
+ Parrot_reallocate_string(interpreter, s, l);
+ } else {
+ Parrot_allocate_string(interpreter, s, l);
}
- else
- internal_exception(1, "readline: buffer too short");
}
out_buf = (unsigned char*)s->strstart + s->strlen;
len = b->next - buf_start;
Modified: branches/leo-ctx5/languages/tcl/lib/commands/catch.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/catch.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/catch.imc Wed Jul 13
11:45:13 2005
@@ -28,6 +28,7 @@
if argc > 2 goto badargs
code = argv[0]
$P1 = parser."parse"(code,0,0)
+ register $P1
# ignoring $P0 here.
($I0,$P0) = interpret($P1)
retval = new Integer
Modified: branches/leo-ctx5/languages/tcl/lib/commands/eval.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/eval.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/eval.imc Wed Jul 13
11:45:13 2005
@@ -37,6 +37,7 @@ loop:
loop_done:
$P1 = parser."parse"(expr,0,0)
+ register $P1
.return interpret($P1)
Modified: branches/leo-ctx5/languages/tcl/lib/commands/for.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/for.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/for.imc Wed Jul 13
11:45:13 2005
@@ -26,10 +26,13 @@
# Parse the bits that are code.
$S0 = start_p
start_parsed = parser."parse"($S0,0,0)
+ register start_parsed
$S0 = next_p
next_parsed = parser."parse"($S0,0,0)
+ register next_parsed
$S0 = body_p
body_parsed = parser."parse"($S0,0,0)
+ register body_parsed
# first, execute start.
Modified: branches/leo-ctx5/languages/tcl/lib/commands/foreach.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/foreach.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/foreach.imc Wed Jul 13
11:45:13 2005
@@ -79,6 +79,7 @@ got_list:
arg_done:
.local pmc parsed
parsed = parser."parse"(body,0,0)
+ register parsed
.local pmc iterator
iterator = new Integer
Modified: branches/leo-ctx5/languages/tcl/lib/commands/if.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/if.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/if.imc Wed Jul 13 11:45:13 2005
@@ -110,6 +110,7 @@ do_else:
done:
$P1 = parser."parse"(code,0,0)
+ register $P1
.return interpret($P1) #tailcall
Modified: branches/leo-ctx5/languages/tcl/lib/commands/proc.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/proc.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/proc.imc Wed Jul 13
11:45:13 2005
@@ -37,6 +37,7 @@ got_args:
.local pmc parsed_body
$S0 = body_p
parsed_body = parser."parse"($S0,0,0)
+ register parsed_body
# XXX these need to go away - for now, we'll just escape
# the code portion and put it, escaped, into the proc
Modified: branches/leo-ctx5/languages/tcl/lib/commands/set.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/set.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/set.imc Wed Jul 13
11:45:13 2005
@@ -25,8 +25,7 @@
getting:
.local pmc read
read = find_global "_Tcl", "__read"
- (return_type, retval) = read(name)
- goto done
+ .return read(name)
setting:
.local pmc set
@@ -34,14 +33,11 @@ setting:
.local pmc value
value = argv[1]
- (return_type, retval) = set(name, value)
- goto done
+ .return set(name,value)
error:
return_type = TCL_ERROR
retval = "wrong # args: should be \"set varName ?newValue?\""
-
-done:
.return(return_type,retval)
catch:
Modified: branches/leo-ctx5/languages/tcl/lib/commands/source.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/source.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/source.imc Wed Jul 13
11:45:13 2005
@@ -43,6 +43,7 @@ loop:
gotfile:
$P1 = parser."parse"(contents,0,0)
+ register $P1
(code,retval) = interpret($P1)
goto done
Modified: branches/leo-ctx5/languages/tcl/lib/commands/time.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/time.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/time.imc Wed Jul 13
11:45:13 2005
@@ -39,6 +39,7 @@ run:
script = argv[0]
$P1 = parser."parse"(script,0,0)
+ register $P1
time $N1
$I1 = count
Modified: branches/leo-ctx5/languages/tcl/lib/commands/while.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/while.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/while.imc Wed Jul 13
11:45:13 2005
@@ -26,6 +26,7 @@
while_loop:
$S0 = body_p
parsed_code = parser."parse"($S0,0,0)
+ register parsed_code
(return_type,retval) = expression_p(cond_p)
if return_type == TCL_ERROR goto done_done
(return_type,retval) = expression_i(retval)
Modified: branches/leo-ctx5/languages/tcl/lib/string_to_list.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/string_to_list.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/string_to_list.imc Wed Jul 13
11:45:13 2005
@@ -19,6 +19,7 @@
push_eh parse_error
parsed_str = parser."parse"(str,0,1)
clear_eh
+ register parsed_str
$I0 = parsed_str
if $I0 == 0 goto done
Modified: branches/leo-ctx5/languages/tcl/lib/tclword.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/tclword.imc (original)
+++ branches/leo-ctx5/languages/tcl/lib/tclword.imc Wed Jul 13 11:45:13 2005
@@ -252,6 +252,7 @@ later interpretation.
.local pmc parser
parser = find_global "_Tcl", "parser"
parsed_cmd = parser."parse"(cmd,0,0)
+ register parsed_cmd
chunk = new FixedPMCArray
chunk = 2
Modified: branches/leo-ctx5/languages/tcl/t/harness
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/harness (original)
+++ branches/leo-ctx5/languages/tcl/t/harness Wed Jul 13 11:45:13 2005
@@ -22,7 +22,9 @@ my @files;
# Per Leo on 18APR2005, run the test suite with --gc-debug
if ($ENV{TEST_PROG_ARGS} && $ENV{TEST_PROG_ARGS} !~ /\b--gc-debug\b/) {
- $ENV{TEST_PROG_ARGS} .= " --gc-debug";
+ $ENV{TEST_PROG_ARGS} .= " --gc-debug ";
+} elsif (! $ENV{TEST_PROG_ARGS} ) {
+ $ENV{TEST_PROG_ARGS} = " --gc-debug ";
}
if ( grep { /^--files$/ } @ARGV ) {
Modified: branches/leo-ctx5/languages/tcl/tcl.imc
==============================================================================
--- branches/leo-ctx5/languages/tcl/tcl.imc (original)
+++ branches/leo-ctx5/languages/tcl/tcl.imc Wed Jul 13 11:45:13 2005
@@ -46,6 +46,7 @@ input_loop:
input_line = readline STDIN
unless STDIN goto done
$P1 = parser."parse"(input_line,0,0)
+ register $P1
(retcode,retval) = interpret($P1)
# print out the result of the evaluation.
isnull retval, input_loop
