cvsuser 05/02/27 02:00:14
Modified: languages/cola README
languages/parakeet README.txt
languages/tcl TODO tcl.imc_template
languages/tcl/lib/commands linsert.imc llength.imc proc.imc
languages/tcl/t cmd_string.t
dynclasses tclint.pmc
Log:
other stuff from Will that came with the string patch
Revision Changes Path
1.18 +0 -4 parrot/languages/cola/README
Index: README
===================================================================
RCS file: /cvs/public/parrot/languages/cola/README,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- README 12 Oct 2003 05:14:49 -0000 1.17
+++ README 27 Feb 2005 10:00:09 -0000 1.18
@@no-spam -167,10 +167,6 @@no-spam
make
- Building imcc:
-
- IMCC is built automatically now when you build Parrot.
-
Usage:
colac examples/mandelbrot.cola
1.2 +1 -1 parrot/languages/parakeet/README.txt
Index: README.txt
===================================================================
RCS file: /cvs/public/parrot/languages/parakeet/README.txt,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- README.txt 5 Oct 2004 09:30:21 -0000 1.1
+++ README.txt 27 Feb 2005 10:00:10 -0000 1.2
@@no-spam -108,7 +108,7 @@no-spam
.POP
print .TOS
print "\n"
- invoke P1
+ #invoke P1
.end
0>
1.33 +5 -1 parrot/languages/tcl/TODO
Index: TODO
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/TODO,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- TODO 18 Jan 2005 02:21:43 -0000 1.32
+++ TODO 27 Feb 2005 10:00:11 -0000 1.33
@@no-spam -2,6 +2,10 @@no-spam
=over 4
+=item [interpinfo name]
+
+how to do this from inside parrot?
+
=item migrate all these issues to RT.
TODO tests would also suffice, where possible.
@@no-spam -82,7 +86,7 @@no-spam
[array nextelement] [array startsearch] [bgerror] [binary]
[case] [clock] [close] [cd] [dde] [encoding] [eof] [exec]
[fblocked] [fconfigure] [fcopy] [file] [fileevent]
-[flush] [gets] [glob] [http] [info] [interp] [library]
+[flush] [gets] [glob] [http] [info]* [interp] [library]
[lindex] [load] [lreplace] [lsearch]* [lset] [lsort]
[memory] [msgcat] [namespace] [open] [package] [pid] [pwd]
[read] [registry] [regexp] [regsub] [resource]
1.13 +3 -0 parrot/languages/tcl/tcl.imc_template
Index: tcl.imc_template
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/tcl.imc_template,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- tcl.imc_template 18 Jan 2005 02:21:43 -0000 1.12
+++ tcl.imc_template 27 Feb 2005 10:00:11 -0000 1.13
@@no-spam -162,6 +162,9 @@no-spam
$P1 = new TclArray
store_global "_Tcl", "proc_body", $P1
+ $P1 = new TclArray
+ store_global "_Tcl", "proc_parsed", $P1
+
# We need to store these ourselves, because creating dynamic
# .subroutines in PIR runs the risk of garbage collection if we're
# not careful.
1.3 +13 -56 parrot/languages/tcl/lib/commands/linsert.imc
Index: linsert.imc
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/lib/commands/linsert.imc,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- linsert.imc 28 Nov 2004 04:49:45 -0000 1.2
+++ linsert.imc 27 Feb 2005 10:00:12 -0000 1.3
@@no-spam -1,71 +1,28 @@no-spam
-#
-# [linsert]
-#
+# XXX simplified version.
.namespace [ "Tcl" ]
-.sub "linsert"
+.sub "lindex"
.local pmc argv
argv = foldup
- # XXX need error handling.
+ .local int argc
+ argc = argv
- .local pmc the_list
- the_list = shift argv
-
- .local pmc position
- position = shift argv
-
- ($I0,$P0,$I2) = _list_index(the_list,position)
- if $I0 != TCL_OK goto error
- if $I2 ==0 goto next
- inc $P0 #linsert treats "end" differently
-
-next:
- .local int the_index
- the_index = $P0
-
- # XXX workaround, splice doesn't work on TclList <-> TclList.
- # Until that's fixed, splice Arrays, then post-covert to a TclList
- # This is a hideous hack.
-
- .local int cnt
- cnt = 0
- $I1 = the_list
- .local pmc argv_list
- argv_list = new Array
- argv_list = $I1
-LOOP:
- if cnt >= $I1 goto DONE
- $P1 = the_list[cnt]
- argv_list[cnt] = $P1
- inc cnt
- goto LOOP
-DONE:
- argv_list = splice argv, the_index, 0
+ if argc != 1 goto indexed
- .local int TclList
- TclList = find_type "TclList"
.local pmc retval
- retval = new TclList
+ retval = argv[0]
- .local int cnt
- cnt = 0
+ .return(TCL_OK,retval)
- .local int argc
- argc = argv_list
-LOOP2:
- if cnt >= argc goto DONE2
- $P0 = argv_list[cnt]
- retval[cnt] = $P0
- inc cnt
- goto LOOP2
-DONE2:
+indexed:
+ # The indices could be a list in a pmc or multiple pmcs. Deal with
+ # it either way... For now, assume they are individual... and singular.
+ .local int index
+ index = argv[1]
+ retval = argv[index]
.return (TCL_OK,retval)
-
-error:
- .return($I0,$P0)
-
.end
1.3 +19 -1 parrot/languages/tcl/lib/commands/llength.imc
Index: llength.imc
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/lib/commands/llength.imc,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- llength.imc 28 Nov 2004 04:49:45 -0000 1.2
+++ llength.imc 27 Feb 2005 10:00:12 -0000 1.3
@@no-spam -8,8 +8,26 @@no-spam
# XXX Need error handling.
- # Need to convert this to a list if it isn't already.
+ $S0 = typeof listval
+ if $S0 == "TclList" goto list_like
+=for when we have set_string_native working in tcllist
+
+ $I0 = find_type "TclList"
+ $P0 = new $I0
+ $S0 = listval
+ $P0 = $S0
+ listval = $P0
+
+=cut
+
+ # what we use in the meantime
+ $P0 = find_global "_Tcl", "__stringToList"
+ $S0 = listval
+ $P1 = $P0($S0)
+ listval = $P1
+
+list_like:
$I0 = listval
$I1 = find_type "TclInt"
1.13 +6 -4 parrot/languages/tcl/lib/commands/proc.imc
Index: proc.imc
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/lib/commands/proc.imc,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- proc.imc 18 Jan 2005 02:21:47 -0000 1.12
+++ proc.imc 27 Feb 2005 10:00:12 -0000 1.13
@@no-spam -45,10 +45,12 @@no-spam
# indvidual argument handling code.
# Now, shove the parsed routine into the global hash...
- $P0 = find_global "_Tcl", "proc_body"
-
+ $P0 = find_global "_Tcl", "proc_parsed"
$P0[name] = parsed_body
- #$P2[name] = arg_list
+
+ # Save the code for the proc.
+ $P1 = find_global "_Tcl", "proc_body"
+ $P1[name] = body_p
.local pmc escaper
escaper = find_global "Data::Escape", "String"
@@no-spam -78,7 +80,7 @@no-spam
goto arg_loop
arg_loop_done:
- proc_body .= ".local pmc interpret\ninterpret = find_global \"_Tcl\", \"__interpret\"\n.local pmc proc_body\n$P0 = find_global \"_Tcl\", \"proc_body\"\nproc_body=$P0[\""
+ proc_body .= ".local pmc interpret\ninterpret = find_global \"_Tcl\", \"__interpret\"\n.local pmc proc_body\n$P0 = find_global \"_Tcl\", \"proc_parsed\"\nproc_body=$P0[\""
proc_body .= esc_name
proc_body .= "\"]\nif I3 == "
$S1 = arg_count
1.4 +0 -6 parrot/languages/tcl/t/cmd_string.t
Index: cmd_string.t
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/t/cmd_string.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- cmd_string.t 27 Dec 2004 19:20:45 -0000 1.3
+++ cmd_string.t 27 Feb 2005 10:00:13 -0000 1.4
@@no-spam -168,14 +168,11 @@no-spam
1
OUT
-TODO: {
-local $TODO = "? doesn't work. PGE issue?\n";
language_output_is("tcl",<<TCL,<<OUT,"string match ?");
puts [string match a?c abc]
TCL
1
OUT
-}
TODO: {
local $TODO = "[] doesn't work. PGE issue.\n";
@@no-spam -198,14 +195,11 @@no-spam
1
OUT
-TODO: {
-local $TODO = "Issue with \? - PGE issue?";
language_output_is("tcl",<<TCL,<<OUT,"string match \?");
puts [string match {\?} ?]
TCL
1
OUT
-}
TODO: {
local $TODO = "Parser error";
1.6 +8 -1 parrot/dynclasses/tclint.pmc
Index: tclint.pmc
===================================================================
RCS file: /cvs/public/parrot/dynclasses/tclint.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- tclint.pmc 12 Dec 2004 23:03:47 -0000 1.5
+++ tclint.pmc 27 Feb 2005 10:00:14 -0000 1.6
@@no-spam -1,7 +1,7 @@no-spam
/* TclInt.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: tclint.pmc,v 1.5 2004/12/12 23:03:47 chromatic Exp $
+ * $Id: tclint.pmc,v 1.6 2005/02/27 10:00:14 leo Exp $
* Overview:
* These are the vtable functions for the TclInt base class
* Data Structure and Algorithms:
@@no-spam -17,8 +17,15 @@no-spam
static INTVAL dynclass_TclFloat;
static INTVAL dynclass_TclInt;
+
+/* Non vtable methods. */
+INTVAL Parrot_TclInt_get_bent(Interp* interpreter,PMC* pmc) {
+ return 1;
+}
+
pmclass TclInt extends TclObject dynpmc group tcl_group {
+
void class_init() {
if (pass) {
dynclass_TclString = Parrot_PMC_typenum(INTERP,"TclString");