perl.cvs.parrot
[Top] [All Lists]

[svn:parrot] r29730 - in branches/gsoc_pdd09: . config/gen/call_list con

Subject: [svn:parrot] r29730 - in branches/gsoc_pdd09: . config/gen/call_list config/init/hints languages/perl6/t languages/tcl/config/makefiles languages/tcl/lib languages/tcl/runtime languages/tcl/runtime/builtin languages/tcl/src languages/tcl/src/builtin languages/tcl/src/grammar/expr languages/tcl/src/pmc languages/tcl/t languages/tcl/tools src t/pmc tools/build
From:
Date: Thu, 24 Jul 2008 13:41:25 -0700 PDT
Newsgroups: perl.cvs.parrot

Author: Whiteknight
Date: Thu Jul 24 13:41:24 2008
New Revision: 29730

Removed:
   branches/gsoc_pdd09/languages/tcl/runtime/list_to_string.pir
Modified:
   branches/gsoc_pdd09/MANIFEST
   branches/gsoc_pdd09/config/gen/call_list/misc.in
   branches/gsoc_pdd09/config/init/hints/darwin.pm
   branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data
   branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in
   branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl
   branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/catch.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/eval.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/expr.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/foreach.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/gets.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/if.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/lindex.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/linsert.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/lreplace.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/lset.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/parray.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/puts.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/source.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/switch.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/trace.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir
   branches/gsoc_pdd09/languages/tcl/runtime/builtin/variable.pir
   branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir
   branches/gsoc_pdd09/languages/tcl/runtime/options.pir
   branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir
   branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir
   branches/gsoc_pdd09/languages/tcl/runtime/variables.pir
   branches/gsoc_pdd09/languages/tcl/src/builtin/expr.pir
   branches/gsoc_pdd09/languages/tcl/src/builtin/lrange.tmt
   branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir
   branches/gsoc_pdd09/languages/tcl/src/pmc/tcldict.pmc
   branches/gsoc_pdd09/languages/tcl/src/tclsh.pir
   branches/gsoc_pdd09/languages/tcl/t/cmd_binary.t
   branches/gsoc_pdd09/languages/tcl/tools/gen_inline.pl
   branches/gsoc_pdd09/src/libnci_test.def
   branches/gsoc_pdd09/src/nci_test.c
   branches/gsoc_pdd09/t/pmc/nci.t
   branches/gsoc_pdd09/tools/build/nativecall.pl

Log:
[gsoc_pdd09] updating to trunk r29729

Modified: branches/gsoc_pdd09/MANIFEST
==============================================================================
--- branches/gsoc_pdd09/MANIFEST        (original)
+++ branches/gsoc_pdd09/MANIFEST        Thu Jul 24 13:41:24 2008
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Jul 22 18:07:34 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Jul 24 03:13:28 2008 UT
 #
 # See tools/dev/install_files.pl for documentation on the
 # format of this file.
@@ -2545,7 +2545,6 @@
 languages/tcl/runtime/builtin/variable.pir                  [tcl]
 languages/tcl/runtime/builtin/vwait.pir                     [tcl]
 languages/tcl/runtime/conversions.pir                       [tcl]
-languages/tcl/runtime/list_to_string.pir                    [tcl]
 languages/tcl/runtime/options.pir                           [tcl]
 languages/tcl/runtime/string_to_list.pir                    [tcl]
 languages/tcl/runtime/tcllib.pir                            [tcl]

Modified: branches/gsoc_pdd09/config/gen/call_list/misc.in
==============================================================================
--- branches/gsoc_pdd09/config/gen/call_list/misc.in    (original)
+++ branches/gsoc_pdd09/config/gen/call_list/misc.in    Thu Jul 24 13:41:24 2008
@@ -353,3 +353,6 @@
 i    JOt
 i    Jt
 i    Ji
+
+v    Vi
+v    p

Modified: branches/gsoc_pdd09/config/init/hints/darwin.pm
==============================================================================
--- branches/gsoc_pdd09/config/init/hints/darwin.pm     (original)
+++ branches/gsoc_pdd09/config/init/hints/darwin.pm     Thu Jul 24 13:41:24 2008
@@ -20,7 +20,7 @@
     # requested by command-line options and force a single, native
     # architecture to being the default build.
     my @flags = qw(ccflags linkflags ldflags ld_share_flags ld_load_flags);
-    my @arches = qw(i386 ppc ppc64 x86_64);
+    my @arches = qw(i386 ppc64 ppc x86_64);
 
     print "\nChecking for -arch flags not explicitly added:\n" if $verbose;
     for my $flag (@flags) {

Modified: branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data      
(original)
+++ branches/gsoc_pdd09/languages/perl6/t/spectest_regression.data      Thu Jul 
24 13:41:24 2008
@@ -55,8 +55,11 @@
 S06-signature/named-placeholders.t              # pure
 S06-signature/positional-placeholders.t         # pure
 S06-signature/slurpy-placeholders.t             # pure
+S06-traits/is-copy.t                            # pure
+S06-traits/is-rw.t
 S12-class/anonymous.t                           # pure
 S12-class/attributes.t                          # pure
+S12-class/inheritance.t
 S12-class/inheritance-class-methods.t
 S12-class/instantiate.t                         # pure
 S12-class/parent_attributes.t                   # pure

Modified: branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in  (original)
+++ branches/gsoc_pdd09/languages/tcl/config/makefiles/root.in  Thu Jul 24 
13:41:24 2008
@@ -66,7 +66,6 @@
 $(C_BUILTIN)/list.pir \
 $(C_BUILTIN)/return.pir \
 runtime/conversions.pir \
-runtime/list_to_string.pir \
 runtime/string_to_list.pir \
 runtime/variables.pir \
 runtime/options.pir \

Modified: branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl     (original)
+++ branches/gsoc_pdd09/languages/tcl/lib/skipped_tests.tcl     Thu Jul 24 
13:41:24 2008
@@ -1,11 +1,35 @@
 # skipped_tests - these are all the tests that the partcl implementation
-# cannot pass. Some of the tests cause harness failures (see RT#40716),
-# others simply require some functionality that we haven't implemented yet.
+# not only cannot pass, but cannot compile, or causes a parrot segfault, etc.
+# must use exact test names.
+#
+# todo_tests - these are the tests that are known to fail because they
+# require a feature we haven't implemented yet. Can use globs to specify
+# a range of skippable tests.
 #
 # stored as a dictionary, with the reason as a key, and the list of tests
 # that require the feature (or cause the listed error) as values.
 
-set skipped_tests [dict create \
+set todo_tests [dict create \
+  {list to string improvements} {
+    list-1.1[23] list-1.26
+  } {parsing errors} {
+    list-1.1[56]
+  } {[trace]} {
+    append-7.[12345]
+    appendComp-7.[123456789]
+    if-10.6
+    lset-1.3 lset-5.[12]
+  } {stacktrace support} {
+    apply-2.[2345] apply-5.1
+    if-5.3    if-6.4
+  } {tcltest: need better [testevalex]} {
+    lset-2.2 lset-7.[12] lset-10.3 lset-13.[012] lset-14.[12]
+  } {[apply]} {
+    apply-[4678].*
+  }
+]
+
+set skip_tests [dict create \
   {[binary]} {
     string-5.14 string-5.15 string-5.16 string-12.21
     stringComp-5.14 stringComp-5.15 stringComp-5.16 stringComp-9.7
@@ -14,20 +38,13 @@
   } {[subst]} {
     parse-18.9 parse-18.12
   } {[trace]} {
-    append-7.1 append-7.2 append-7.3 append-7.4 append-7.5
-    appendComp-7.1 appendComp-7.2 appendComp-7.3 appendComp-7.4 appendComp-7.5
-    appendComp-7.6 appendComp-7.7 appendComp-7.8 appendComp-7.9
-    if-10.6
-    lset-1.3 lset-5.1 lset-5.2
   } {stacktrace support} {
-    apply-2.2 apply-2.3 apply-2.4 apply-2.5 apply-5.1
     basic-46.1
     cmdMZ-return-2.10 cmdMZ-3.5 cmdMZ-5.7
     dict-14.12 dict-17.13
     error-1.3 error-2.3 error-2.6 error-4.2 error-4.3 error-4.4
     eval-2.5
     iocmd-12.6
-    if-5.3 if-6.4
     incr-2.30 incr-2.31
     incr-old-2.4 incr-old-2.5
     misc-1.2
@@ -88,7 +105,7 @@
     namespace-27.2 namespace-27.3
   } {nested dictionaries} {
     dict-3.5 dict-3.6 dict-3.7 dict-3.8 dict-3.9 dict-3.10 dict-9.3 dict-9.4
-    dict-9.5 dict-15.3 dict-15.5 dict-16.4
+    dict-9.5 dict-15.3 dict-15.5 dict-16.4 dict-21.16
   } {support for the variable named ""} {
     var-6.3 var-7.12 var-12.1
   } {Cannot get character past end of string} {
@@ -231,7 +248,6 @@
 # stored as an array of test name -> reason pairs.
 
 array set abort_after {
-  apply-2.1            {}
   assocd-1.1           {}
   async-1.1            {}
   autoMkindex-1.1      {}

Modified: branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl (original)
+++ branches/gsoc_pdd09/languages/tcl/lib/test_more.tcl Thu Jul 24 13:41:24 2008
@@ -121,29 +121,51 @@
 
 # A placeholder that simulates the real tcltest's exported test proc.
 proc test {num description args} {
-    global skipped_tests
+    global skip_tests
+    global todo_tests
     global abort_after
-    if {![info exists skipped_tests]} {
+    if {![info exists skip_tests]} {
         # get listing of all the tests we can't run.
         source lib/skipped_tests.tcl
     }
 
     set full_desc "$num $description"
 
-    set should_skip [dict filter $skipped_tests script {K V} {
+    set should_skip [dict filter $skip_tests script {K V} {
         set val [lsearch -exact $V $num]
         expr {$val != -1}
     }]
 
-    set reason [dict keys $should_skip]
+    set skip_reason [dict keys $should_skip]
 
-    if {[string length $reason]} {
-        pass $full_desc [list SKIP $reason]
+    set should_todo [dict filter $todo_tests script {K V} {
+        set matched no
+        foreach element $V {
+          if {[string match $element $num]} {
+           set matched yes
+           break
+         }
+       }
+        set matched
+    }]
+
+    set todo_reason [dict keys $should_todo]
+
+    if {[string length $skip_reason]} {
+        pass $full_desc [list SKIP $skip_reason]
     } elseif {[llength $args] == 2} {
-        eval_is [lindex $args 0] [lindex $args 1] $full_desc
+        if {[string length $todo_reason]} {
+          eval_is [lindex $args 0] [lindex $args 1] $full_desc "TODO 
{$todo_reason}"
+       } else {
+          eval_is [lindex $args 0] [lindex $args 1] $full_desc
+       }
     } elseif {[llength $args] == 3} {
         # XXX : we're just skipping the constraint here...
-        eval_is [lindex $args 1] [lindex $args 2] $full_desc
+        if {[string length $todo_reason]} {
+          eval_is [lindex $args 1] [lindex $args 2] $full_desc "TODO 
{$todo_reason}"
+       } else {
+          eval_is [lindex $args 1] [lindex $args 2] $full_desc
+       }
     } else {
         # Skip test if too many or two few args.
         pass $full_desc [list SKIP {can't deal with this version of test yet}]

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/catch.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/catch.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/catch.pir Thu Jul 24 
13:41:24 2008
@@ -16,15 +16,15 @@
   $P0 = getinterp
   ns = $P0['namespace'; 1]
 
-  .local pmc __script
-  __script = get_root_global ['_tcl'], '__script'
+  .local pmc compileTcl
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
 
   if argc == 0 goto bad_args
   if argc  > 3 goto bad_args
 
   code = argv[0]
   push_eh non_ok
-    $P2 = __script(code, 'ns' => ns)
+    $P2 = compileTcl(code, 'ns' => ns)
     code_retval = $P2()
     retval = .CONTROL_OK
   pop_eh

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/dict.pir  Thu Jul 24 
13:41:24 2008
@@ -204,9 +204,9 @@
   options[1] = 'script'
   options[2] = 'value'
 
-  .local pmc select_option, __script, toBoolean
+  .local pmc select_option, compileTcl, toBoolean
   select_option  = get_root_global ['_tcl'], 'select_option'
-  __script  = get_root_global ['_tcl'], '__script'
+  compileTcl  = get_root_global ['_tcl'], 'compileTcl'
   toBoolean  = get_root_global ['_tcl'], 'toBoolean'
   .local pmc option
   option = shift argv
@@ -270,7 +270,7 @@
   .local pmc retval
   retval = new 'TclDict'
   .local pmc body_proc
-  body_proc = __script(body)
+  body_proc = compileTcl(body)
 
   .local pmc check_key,check_value
 script_loop:
@@ -321,7 +321,7 @@
 
   .local pmc set, script
   set     = get_root_global ['_tcl'], 'setVar'
-  script  = get_root_global ['_tcl'], '__script'
+  script  = get_root_global ['_tcl'], 'compileTcl'
 
   .local pmc varNames
   .local string keyVar, valueVar
@@ -339,7 +339,7 @@
 
   .local pmc body,code
   body = shift argv
-  code = __script(body)
+  code = compileTcl(body)
 
   .local pmc iterator
   iterator = new 'Iterator', dictionary
@@ -903,7 +903,7 @@
 done_key_loop:
 # run the body of the script. save the return vaalue.
   .local pmc retval
-  $P1 = __script(body)
+  $P1 = compileTcl(body)
   retval = $P1()
 
 # go through the varnames, setting the appropriate keys to those values.
@@ -1028,7 +1028,7 @@
   goto alias_keys
 done_alias:
   .local pmc retval
-  $P1 = __script(body)
+  $P1 = compileTcl(body)
   retval = $P1()
 
   iterator = new 'Iterator', dictionary

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/eval.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/eval.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/eval.pir  Thu Jul 24 
13:41:24 2008
@@ -18,12 +18,12 @@
   $P0 = getinterp
   ns  = $P0['namespace'; 1]
 
-  .local pmc __script
-  __script = get_root_global ['_tcl'], '__script'
+  .local pmc compileTcl
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
 
   .local string code
   code = join ' ', argv
-  $P2  = __script(code, 'ns'=>ns)
+  $P2  = compileTcl(code, 'ns'=>ns)
   .return $P2()
 
 bad_args:

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/expr.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/expr.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/expr.pir  Thu Jul 24 
13:41:24 2008
@@ -14,8 +14,8 @@
   .local int argc
   .local int looper
 
-  .local pmc __expr
-  __expr = get_root_global ['_tcl'], '__expr'
+  .local pmc compileExpr
+  compileExpr = get_root_global ['_tcl'], 'compileExpr'
 
   expr = ''
   looper = 0
@@ -29,7 +29,7 @@
   $P0 = getinterp
   ns  = $P0['namespace'; 1]
 
-  $P1 = __expr(expr, 'ns'=>ns)
+  $P1 = compileExpr(expr, 'ns'=>ns)
   $P2 = $P1()
   .return ($P2)
 

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir     
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/fileevent.pir     Thu Jul 
24 13:41:24 2008
@@ -10,9 +10,9 @@
     if argc < 2 goto badargs
     if argc > 3 goto badargs
 
-    .local pmc __channel, __script
-    __channel = get_root_global ['_tcl'], '__channel'
-    __script  = get_root_global ['_tcl'], '__script'
+    .local pmc getChannel, compileTcl
+    getChannel = get_root_global ['_tcl'], 'getChannel'
+    compileTcl  = get_root_global ['_tcl'], 'compileTcl'
 
     .local pmc channel, script
     .local string event
@@ -26,13 +26,13 @@
     tcl_error $S0
 
 readable:
-    channel = __channel(channel)
+    channel = getChannel(channel)
 
     if argc == 2 goto readable_2
 
     .local pmc script
     script = args[2]
-    script = __script(script)
+    script = compileTcl(script)
 
     .local pmc events
     events = get_root_global ['_tcl'], 'events'
@@ -47,7 +47,7 @@
     .return('')
 
 writable:
-    channel = __channel(channel)
+    channel = getChannel(channel)
     .return('')
 
 badargs:

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/foreach.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/foreach.pir       
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/foreach.pir       Thu Jul 
24 13:41:24 2008
@@ -17,16 +17,16 @@
   $P0 = getinterp
   ns  = $P0['namespace'; 1]
 
-  .local pmc toList, __script, setVar
+  .local pmc toList, compileTcl, setVar
   toList   = get_root_global ['_tcl'], 'toList'
-  __script = get_root_global ['_tcl'], '__script'
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
   setVar    = get_root_global ['_tcl'], 'setVar'
 
   .local pmc varLists, lists, command
   varLists = new 'TclList'
   lists    = new 'TclList'
   command  = pop argv
-  command  = __script(command, 'ns'=>ns)
+  command  = compileTcl(command, 'ns'=>ns)
 
   .local int iterations
   iterations = 0

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/gets.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/gets.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/gets.pir  Thu Jul 24 
13:41:24 2008
@@ -18,11 +18,11 @@
   .local string channelID
   channelID = argv[0]
 
-  .local pmc __channel
-  __channel = get_root_global ['_tcl'], '__channel'
+  .local pmc getChannel
+  getChannel = get_root_global ['_tcl'], 'getChannel'
 
   .local pmc io
-  io = __channel(channelID)
+  io = getChannel(channelID)
 
   $S0 = typeof io
   if $S0 == 'TCPStream' goto stream

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/if.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/if.pir    (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/if.pir    Thu Jul 24 
13:41:24 2008
@@ -10,8 +10,8 @@
     .local int argc
     argc = elements argv
 
-    .local pmc __expr
-    __expr = get_root_global ['_tcl'], '__expr'
+    .local pmc compileExpr
+    compileExpr = get_root_global ['_tcl'], 'compileExpr'
 
     if argc == 0 goto no_args
 
@@ -26,7 +26,7 @@
 
     # convert to the expression to a Sub
     $S0 = argv[0]
-    $P0 = __expr($S0, 'ns'=>ns)
+    $P0 = compileExpr($S0, 'ns'=>ns)
 
     $I0 = 1
     if $I0 == argc goto no_script
@@ -61,7 +61,7 @@
 
     # convert to the expression to a Sub
     $S0 = argv[$I0]
-    $P0 = __expr($S0)
+    $P0 = compileExpr($S0)
 
     inc $I0
     if $I0 == argc goto no_script
@@ -90,8 +90,8 @@
 arg_end:
 
     # now we can do the actual evaluation
-    .local pmc __script, toBoolean
-    __script  = get_root_global ['_tcl'], '__script'
+    .local pmc compileTcl, toBoolean
+    compileTcl  = get_root_global ['_tcl'], 'compileTcl'
     toBoolean = get_root_global ['_tcl'], 'toBoolean'
 
     .local pmc    cond
@@ -104,7 +104,7 @@
     $P1 = cond()
     $I1 = toBoolean($P1)
     unless $I1 goto next
-    $P0 = __script(code, 'ns'=>ns)
+    $P0 = compileTcl(code, 'ns'=>ns)
     .return $P0()
 
 next:
@@ -129,7 +129,7 @@
 else:
     inc $I0
     code = argv[$I0]
-    $P0  = __script(code, 'ns'=>ns)
+    $P0  = compileTcl(code, 'ns'=>ns)
     .return $P0()
 
 extra_words_after_else:

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/info.pir  Thu Jul 24 
13:41:24 2008
@@ -77,12 +77,12 @@
   .local string procname
   procname = shift argv
 
-  .local pmc __namespace
-  __namespace = get_root_global ['_tcl'], '__namespace'
+  .local pmc splitNamespace
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
 
   .local pmc    ns
   .local string name
-  ns   = __namespace(procname)
+  ns   = splitNamespace(procname)
   name = pop ns
   name = '&' . name
 
@@ -116,12 +116,12 @@
   .local string procname
   procname = argv[0]
 
-  .local pmc __namespace
-  __namespace = get_root_global ['_tcl'], '__namespace'
+  .local pmc splitNamespace
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
 
   .local pmc    ns
   .local string name
-  ns   = __namespace(procname)
+  ns   = splitNamespace(procname)
   name = pop ns
   name = '&' . name
 
@@ -151,7 +151,7 @@
   .local pmc body
   body = argv[0]
   push_eh nope
-    $P1 = __script(body)
+    $P1 = compileTcl(body)
   pop_eh
   .return(1)
 
@@ -186,12 +186,12 @@
   .local pmc setVar
   setVar = get_root_global ['_tcl'], 'setVar'
 
-  .local pmc __namespace
-  __namespace = get_root_global ['_tcl'], '__namespace'
+  .local pmc splitNamespace
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
 
   .local pmc    ns
   .local string name
-  ns   = __namespace(procname)
+  ns   = splitNamespace(procname)
   name = pop ns
   name = '&' . name
 
@@ -474,15 +474,15 @@
   .return($I0)
 
 find_level:
-  .local pmc toInteger, __call_level
+  .local pmc toInteger, getCallLevel
   toInteger    = get_root_global ['_tcl'], 'toInteger'
-  __call_level = get_root_global ['_tcl'], '__call_level'
+  getCallLevel = get_root_global ['_tcl'], 'getCallLevel'
 
   .local pmc level
   level = shift argv
   level = toInteger(level)
   if level >= 0 goto find_info_level
-  level = __call_level(level)
+  level = getCallLevel(level)
   .return(level)
 
 find_info_level:

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/lindex.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/lindex.pir        
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/lindex.pir        Thu Jul 
24 13:41:24 2008
@@ -11,9 +11,9 @@
   argc = argv
   if argc < 1 goto bad_args
 
-  .local pmc toList, __index
+  .local pmc toList, getIndex
   toList  = get_root_global ['_tcl'], 'toList'
-  __index = get_root_global ['_tcl'], '__index'
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   .local pmc list
   list = argv[0]
@@ -49,7 +49,7 @@
   list = toList(list)
 
   $P0 = indices[$I1]
-  index = __index($P0, list)
+  index = getIndex($P0, list)
 
   $I2 = elements list
   if index >= $I2 goto empty

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/linsert.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/linsert.pir       
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/linsert.pir       Thu Jul 
24 13:41:24 2008
@@ -22,11 +22,11 @@
   .local string position
   position = shift argv
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   .local int the_index
-  the_index = __index(position, the_list)
+  the_index = getIndex(position, the_list)
 
   $S0 = substr position, 0, 3
   if $S0 != 'end' goto next

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/lreplace.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/lreplace.pir      
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/lreplace.pir      Thu Jul 
24 13:41:24 2008
@@ -11,9 +11,9 @@
     argc = elements argv
     if argc < 3 goto bad_args
 
-    .local pmc list, toList, retval, iterator, __index
+    .local pmc list, toList, retval, iterator, getIndex
     toList = get_root_global ['_tcl'], 'toList'
-    __index = get_root_global ['_tcl'], '__index'
+    getIndex = get_root_global ['_tcl'], 'getIndex'
     $P0 = shift argv
     list = toList($P0)
     list = clone list
@@ -23,9 +23,9 @@
 
     .local int first, last, count
     $S0 = shift argv
-    first = __index($S0,list)
+    first = getIndex($S0,list)
     $S0  = shift argv
-    last = __index($S0,list)
+    last = getIndex($S0,list)
 
     if size == 0   goto empty
     if last < size goto first_1

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/lset.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/lset.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/lset.pir  Thu Jul 24 
13:41:24 2008
@@ -31,8 +31,8 @@
   if argc == 1 goto replace
 
 lset:
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   unless argc == 2 goto iterate
   $P0 = argv[1]
@@ -56,7 +56,7 @@
   if $I0 == $I1 goto outer_loop
 
   $P0 = indices[$I0]
-  $I2 = __index($P0, list)
+  $I2 = getIndex($P0, list)
   if $I2 < 0 goto out_of_range
   $I3 = elements list
   if $I2 >= $I3 goto out_of_range

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir     
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/namespace.pir     Thu Jul 
24 13:41:24 2008
@@ -76,9 +76,9 @@
   argc = argv
   if argc goto bad_args
 
-  .local pmc ns, __namespace
-  __namespace = get_root_global ['_tcl'], '__namespace'
-  ns  = __namespace('')
+  .local pmc ns, splitNamespace
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
+  ns  = splitNamespace('')
   $S0 = join '::', ns
   $S0 = '::' . $S0
   .return($S0)
@@ -95,15 +95,15 @@
   # no arg delete does nothing
   if argc == 0 goto return
 
-  .local pmc __namespace, ns_root
-  __namespace = get_root_global ['_tcl'], '__namespace'
+  .local pmc splitNamespace, ns_root
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
   ns_root = get_root_namespace ['tcl']
 
   $I0 = 0
 delete_loop:
   if $I0 == argc goto return
   $S0 = argv[$I0]
-  $P0 = __namespace($S0)
+  $P0 = splitNamespace($S0)
   $I1 = 0
   $I2 = elements $P0
   dec $I2
@@ -245,11 +245,11 @@
   unshift $P0, 'namespace'
   unshift info_level, $P0
 
-  .local pmc ns, __namespace
-  __namespace = get_root_global ['_tcl'], '__namespace'
+  .local pmc ns, splitNamespace
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
 
   ns = shift argv
-  ns = __namespace(ns, 1)
+  ns = splitNamespace(ns, 1)
 
   .local string namespace
   namespace = ''
@@ -261,11 +261,11 @@
   namespace .= "']"
 
 global_ns:
-  .local pmc __script, code
-  __script = get_root_global ['_tcl'], '__script'
+  .local pmc compileTcl, code
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
   code     = new 'CodeString'
   $S0 = join ' ', argv
-  ($S0, $S1) = __script($S0, 'pir_only'=>1)
+  ($S0, $S1) = compileTcl($S0, 'pir_only'=>1)
   $I0 = code.unique()
   code.emit(<<'END_PIR', namespace, $S0, $I0, $S1)
 .HLL 'tcl', 'tcl_group'
@@ -327,15 +327,15 @@
   .local pmc list
   list = new 'TclList'
 
-  .local pmc __namespace, ns, ns_name
+  .local pmc splitNamespace, ns, ns_name
   .local string name
-  __namespace = get_root_global ['_tcl'], '__namespace'
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
   name = ''
   if argc == 0 goto getname
 
   name = argv[0]
 getname:
-  ns_name  = __namespace(name, 1)
+  ns_name  = splitNamespace(name, 1)
 
   unshift ns_name, 'tcl'
   ns = get_root_namespace ns_name
@@ -455,9 +455,9 @@
   name = argv[0]
 
 get_parent:
-  .local pmc ns, __namespace
-  __namespace = get_root_global ['_tcl'], '__namespace'
-  ns  = __namespace(name)
+  .local pmc ns, splitNamespace
+  splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
+  ns  = splitNamespace(name)
   if $S0 != '' goto no_pop
   # for when someone calls [namespace current] from ::
   push_eh current_in_root

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/parray.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/parray.pir        
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/parray.pir        Thu Jul 
24 13:41:24 2008
@@ -26,7 +26,7 @@
   $P99 = open $S0, '<'
   $S0 = $P99.'slurp'('')
 
-  script = get_root_global ['_tcl'], '__script'
+  script = get_root_global ['_tcl'], 'compileTcl'
 
   # compile to PIR and put the sub in place...
   $P1 = script($S0)

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/proc.pir  Thu Jul 24 
13:41:24 2008
@@ -21,11 +21,11 @@
   args      = argv[1]
   body      = argv[2]
 
-  .local pmc pir_compiler, __script, toList, __namespace
+  .local pmc pir_compiler, compileTcl, toList, splitNamespace
   pir_compiler = compreg 'PIR'
-  __script     = get_root_global ['_tcl'], '__script'
+  compileTcl     = get_root_global ['_tcl'], 'compileTcl'
   toList       = get_root_global ['_tcl'], 'toList'
-  __namespace  = get_root_global ['_tcl'], '__namespace'
+  splitNamespace  = get_root_global ['_tcl'], 'splitNamespace'
 
   .local pmc code, args_code, defaults
   .local string namespace
@@ -41,7 +41,7 @@
 
   if full_name == '' goto create
 
-  ns   = __namespace(full_name, 1)
+  ns   = splitNamespace(full_name, 1)
   $I0  = elements ns
   if $I0 == 0 goto create
   name = pop ns
@@ -209,7 +209,7 @@
 
   # Save the parsed body.
   .local string parsed_body, body_reg
-  (parsed_body, body_reg) = __script(body, 'pir_only'=>1)
+  (parsed_body, body_reg) = compileTcl(body, 'pir_only'=>1)
 
   code .= parsed_body
 

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/puts.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/puts.pir  (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/puts.pir  Thu Jul 24 
13:41:24 2008
@@ -15,8 +15,8 @@
   .local int utf8
   utf8 = find_encoding 'utf8'
 
-  .local pmc __channel, io
-  __channel = get_root_global ['_tcl'], '__channel'
+  .local pmc getChannel, io
+  getChannel = get_root_global ['_tcl'], 'getChannel'
 
   if argc == 1 goto one_arg
   if argc == 2 goto two_arg
@@ -26,7 +26,7 @@
   if $S1 != '-nonewline' goto bad_option
 
   $S2 = argv[1]
-  io  = __channel($S2)
+  io  = getChannel($S2)
   $S3 = argv[2]
   $S3 = trans_encoding $S3, utf8
 
@@ -51,7 +51,7 @@
   goto done
 
 two_arg_channel:
-  io = __channel($S2)
+  io = getChannel($S2)
 
   io.'say'($S3)
   goto done

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/source.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/source.pir        
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/source.pir        Thu Jul 
24 13:41:24 2008
@@ -24,9 +24,9 @@
   interp = getinterp
   ns = interp['namespace';1]
 
-  .local pmc __script, code
-  __script = get_root_global ['_tcl'], '__script'
-  code = __script ( file_contents, 'ns' => ns, 'bsnl' => 1)
+  .local pmc compileTcl, code
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
+  code = compileTcl ( file_contents, 'ns' => ns, 'bsnl' => 1)
 
   .return code()
 

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir        
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/string.pir        Thu Jul 
24 13:41:24 2008
@@ -79,11 +79,11 @@
   $I0 = 0
   if argc == 2 goto first_do
   $S3 = argv[2]
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
-  $I0 = __index($S3,$S2)
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
+  $I0 = getIndex($S3,$S2)
   if $I0 >0 goto first_do
-  $I0 = 0 # XXX should this be done in __index?
+  $I0 = 0 # XXX should this be done in getIndex?
 
 first_do:
   .local int index_1
@@ -111,9 +111,9 @@
   if argc == 2 goto last_do
 
   $S3 = argv[2]
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
-  $I1 = __index($S3,$S2)
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
+  $I1 = getIndex($S3,$S2)
 
   if $I1 > $I0 goto last_do
   $I0 = $I1
@@ -152,9 +152,9 @@
   if argc != 2 goto bad_index
   $S1 = argv[0]
   $S2 = argv[1]
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
-  $I0 = __index($S2,$S1)
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
+  $I0 = getIndex($S2,$S1)
   index_1 = length $S1
   inc index_1
   if $I0 > index_1 goto index_null
@@ -191,17 +191,17 @@
   $I3 = $I1
   if argc == 1 goto tolower_do
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   $S2 = argv[1]
-  $I2 = __index($S2, $S1)
+  $I2 = getIndex($S2, $S1)
   # if just the first is specified, the last is the same (tclsh says so)
   $I3 = $I2
   if argc == 2 goto tolower_do
 
   $S3 = argv[2]
-  $I3 = __index($S3, $S1)
+  $I3 = getIndex($S3, $S1)
 
 tolower_do:
   if $I2 > $I1  goto tolower_return
@@ -244,17 +244,17 @@
   $I3 = $I1
   if argc == 1 goto toupper_do
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   $S2 = argv[1]
-  $I2 = __index($S2, $S1)
+  $I2 = getIndex($S2, $S1)
   # if just the first is specified, the last is the same (tclsh says so)
   $I3 = $I2
   if argc == 2 goto toupper_do
 
   $S3 = argv[2]
-  $I3 = __index($S3, $S1)
+  $I3 = getIndex($S3, $S1)
 
 toupper_do:
   if $I2 > $I1  goto toupper_return
@@ -296,17 +296,17 @@
   $I3 = $I1
   if argc == 1 goto totitle_do
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   $S2 = argv[1]
-  $I2 = __index($S2, $S1)
+  $I2 = getIndex($S2, $S1)
   # if just the first is specified, the last is the same (tclsh says so)
   $I3 = $I2
   if argc == 2 goto totitle_do
 
   $S3 = argv[2]
-  $I3 = __index($S3, $S1)
+  $I3 = getIndex($S3, $S1)
 
 totitle_do:
   if $I2 > $I1  goto totitle_return
@@ -376,12 +376,12 @@
   last_index = length teh_string
   dec last_index
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   .local int first_i, last_i
-  first_i = __index(first_s, teh_string)
-  last_i  = __index(last_s, teh_string)
+  first_i = getIndex(first_s, teh_string)
+  last_i  = getIndex(last_s, teh_string)
 
   if first_i > last_i goto done
 
@@ -827,8 +827,8 @@
   .local int len
   .local pmc retval
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   argc = argv
   if argc > 4 goto bad_args
@@ -842,12 +842,12 @@
   $S4 = ''
 
   low_s = argv[1]
-  low = __index(low_s, the_string)
+  low = getIndex(low_s, the_string)
 
   if low >= string_len goto replace_done
 
   high_s = argv[2]
-  high = __index(high_s, the_string)
+  high = getIndex(high_s, the_string)
 
   if high < low goto replace_done
 
@@ -1091,9 +1091,9 @@
   str = argv[0]
   idx = argv[1]
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
-  idx = __index(idx, str)
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
+  idx = getIndex(idx, str)
 
   $I0 = length str
   $I0 -= idx
@@ -1121,13 +1121,13 @@
   str = argv[0]
   idx = argv[1]
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
-  idx = __index(idx, str)
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
+  idx = getIndex(idx, str)
 
   .local int pos
   pos = idx
-  # XXX should these checks be in __index itself?
+  # XXX should these checks be in getIndex itself?
   if pos >0 goto check_upper
   pos = 0
   goto pre_loop

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/subst.pir Thu Jul 24 
13:41:24 2008
@@ -35,10 +35,10 @@
     astgrammar = new 'TclExpr::PAST::Grammar'
     pirgrammar = new 'TclExpr::PIR::Grammar'
 
-    .local pmc __namespace, ns
+    .local pmc splitNamespace, ns
     .local string namespace
-    __namespace = get_root_global ['_tcl'], '__namespace'
-    ns          = __namespace('', 2)
+    splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
+    ns          = splitNamespace('', 2)
     namespace   = ''
     $I0 = elements ns
     if $I0 == 0 goto loop

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/switch.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/switch.pir        
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/switch.pir        Thu Jul 
24 13:41:24 2008
@@ -142,9 +142,9 @@
   code = shift body
 body_match:
   if code == '-' goto fallthrough
-  .local pmc __script
-  __script = get_root_global ['_tcl'], '__script'
-  $P1 = __script(code)
+  .local pmc compileTcl
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
+  $P1 = compileTcl(code)
   .return $P1()
 
 extra_pattern:

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/trace.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/trace.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/trace.pir Thu Jul 24 
13:41:24 2008
@@ -1,18 +1,11 @@
-# RT#40703: Stub
-# help tcltest compile
-
-.HLL '_Tcl', 'tcl_group'
+.HLL 'Tcl', 'tcl_group'
 .namespace []
 
-.sub 'trace'
-  .param string retval
-  .param pmc    raw_args
-  .param pmc    argv
-
+.sub '&trace'
+  .param pmc argv :slurpy
   .return('')
 .end
 
-
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir       
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/uplevel.pir       Thu Jul 
24 13:41:24 2008
@@ -14,9 +14,9 @@
   argc = elements argv
   if argc == 0 goto bad_args
 
-  .local pmc __script, __call_level
-  __script        = get_root_global ['_tcl'], '__script'
-  __call_level    = get_root_global ['_tcl'], '__call_level'
+  .local pmc compileTcl, getCallLevel
+  compileTcl        = get_root_global ['_tcl'], 'compileTcl'
+  getCallLevel    = get_root_global ['_tcl'], 'getCallLevel'
 
   # save the old call level
   .local pmc call_chain
@@ -28,7 +28,7 @@
   new_call_level = argv[0]
 
   .local int defaulted
-  (new_call_level,defaulted) = __call_level(new_call_level)
+  (new_call_level,defaulted) = getCallLevel(new_call_level)
   if defaulted == 1 goto skip
 
   # if we only have a level, then we don't have a command to run!
@@ -56,7 +56,7 @@
   # if we get an exception, we have to reset the environment
   .local pmc retval
   push_eh restore_and_rethrow
-    $P0 = __script($S0)
+    $P0 = compileTcl($S0)
     retval = $P0()
   pop_eh
 

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/upvar.pir Thu Jul 24 
13:41:24 2008
@@ -11,15 +11,15 @@
   argc = elements argv
   if argc < 2 goto bad_args
 
-  .local pmc __call_level, call_chain
+  .local pmc getCallLevel, call_chain
   .local int call_level
-  __call_level = get_root_global ['_tcl'], '__call_level'
+  getCallLevel = get_root_global ['_tcl'], 'getCallLevel'
   call_chain   = get_root_global ['_tcl'], 'call_chain'
   call_level   = elements call_chain
 
   .local int new_call_level, defaulted
   $P0 = argv[0]
-  (new_call_level,defaulted) = __call_level($P0)
+  (new_call_level,defaulted) = getCallLevel($P0)
   if defaulted == 1 goto skip
   $P1 = shift argv
   dec argc
@@ -87,7 +87,7 @@
 
   .local pmc ns
   .local string name
-  ns   = __namespace(new_var, 1)
+  ns   = splitNamespace(new_var, 1)
   name = pop ns
   name = '$' . name
 

Modified: branches/gsoc_pdd09/languages/tcl/runtime/builtin/variable.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/builtin/variable.pir      
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/builtin/variable.pir      Thu Jul 
24 13:41:24 2008
@@ -11,10 +11,10 @@
     argc = elements argv
     if argc == 0 goto bad_args
 
-    .local pmc findVar, storeVar, __namespace
+    .local pmc findVar, storeVar, splitNamespace
     findVar  = get_root_global ['_tcl'], 'findVar'
     storeVar = get_root_global ['_tcl'], 'storeVar'
-    __namespace = get_root_global ['_tcl'], '__namespace'
+    splitNamespace = get_root_global ['_tcl'], 'splitNamespace'
 
     .local pmc iter, name, value, ns
     iter = new 'Iterator', argv
@@ -37,7 +37,7 @@
     unless iter goto no_value
     value = shift iter
 
-    ns = __namespace(name)
+    ns = splitNamespace(name)
     $S0 = ns[-1]
     # store as a lexical *and* a global
     storeVar($S0, value)
@@ -45,7 +45,7 @@
     goto loop
 
 no_value:
-    ns = __namespace(name)
+    ns = splitNamespace(name)
     $S0 = ns[-1]
     # if the variable exists, just insert it as a lexical
     # otherwise, create a new Undef and insert it as both lexical and global

Modified: branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir   (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/conversions.pir   Thu Jul 24 
13:41:24 2008
@@ -57,7 +57,7 @@
 .sub toDict :multi(_)
   .param pmc value
 
-  $P0 = __stringToDict(value)
+  $P0 = stringToDict(value)
   copy value, $P0
 
   .return(value)
@@ -185,14 +185,14 @@
   rethrow $P99 # preserves the invalid octal message.
 .end
 
-=head2 _Tcl::__index
+=head2 _Tcl::getIndex
 
 Given a tcl string index and an List pmc, return the corresponding numeric
 index.
 
 =cut
 
-.sub __index
+.sub getIndex
   .param string idx
   .param pmc    list
 
@@ -249,13 +249,13 @@
   tcl_error $S0
 .end
 
-=head2 _Tcl::__channel
+=head2 _Tcl::getChannel
 
 Given a string, return the appropriate channel.
 
 =cut
 
-.sub __channel
+.sub getChannel
   .param string channelID
 
   .local pmc channels
@@ -283,13 +283,13 @@
 
 .end
 
-=head2 _Tcl::__expr
+=head2 _Tcl::compileExpr
 
 Given an expression, return a subroutine, or optionally, the raw PIR
 
 =cut
 
-.sub __expr
+.sub compileExpr
     .param string expression
     .param int    pir_only :named('pir_only') :optional
     .param pmc    ns       :named('ns')       :optional
@@ -372,13 +372,13 @@
     tcl_error "empty expression\nin expression \"\""
 .end
 
-=head2 _Tcl::__script
+=head2 _Tcl::compileTcl
 
 Given a chunk of tcl code, return a subroutine.
 
 =cut
 
-.sub __script
+.sub compileTcl
     .param string code
     .param int    pir_only    :named('pir_only') :optional
     .param pmc    ns          :named('ns')       :optional
@@ -475,13 +475,13 @@
     tcl_error $S0
 .end
 
-=head2 _Tcl::__namespace
+=head2 _Tcl::splitNamespace
 
 Given a string namespace, return an array of names.
 
 =cut
 
-.sub __namespace
+.sub splitNamespace
   .param string name
   .param int    depth     :optional
   .param int    has_depth :opt_flag
@@ -583,7 +583,7 @@
     .return(0)
 .end
 
-=head2 _Tcl::__call_level
+=head2 _Tcl::getCallLevel
 
 Given a pmc containing the tcl-style call level, return an int-like pmc
 indicating the parrot-style level, and an integer with a boolean 0/1 -
@@ -591,7 +591,7 @@
 
 =cut
 
-.sub __call_level
+.sub getCallLevel
   .param pmc tcl_level
   .local pmc parrot_level, defaulted, orig_level
   defaulted = new 'Integer'

Modified: branches/gsoc_pdd09/languages/tcl/runtime/options.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/options.pir       (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/options.pir       Thu Jul 24 
13:41:24 2008
@@ -50,31 +50,45 @@
 
 check_partial:
   $I1 = elements partials
-  if $I1 == 0 goto no_match
-  if $I1 >1 goto ambiguous
+  if type_name == 'subcommand' goto check_subcommand
+  if $I1 == 0 goto no_match_option
+  if $I1 >1 goto ambiguous_option
+  option = partials[0]
+
+check_subcommand:
+  if $I1 != 1 goto unknown_subcommand
   option = partials[0]
 
 got_match:
   .return (option)
 
-no_match:
+no_match_option:
   error = 'bad '
   error .= type_name
   error .= ' "'
   error .= choice
   error .= '": must be '
-  $S1 = __options_to_string(options)
+  $S1 = optionsToString(options)
   error .= $S1
   tcl_error error
 
-ambiguous:
+ambiguous_option:
   error = 'ambiguous '
   error .= type_name
   error .= ' "'
   error .= choice
   error .= '": must be '
-  # $S1 = __options_to_string(partials)  # Now, I like this better...
-  $S1 = __options_to_string(options)
+  $S1 = optionsToString(options)
+  error .= $S1
+  tcl_error error
+
+unknown_subcommand:
+  error = 'unknown or ambiguous '
+  error .= type_name
+  error .= ' "'
+  error .= choice
+  error .= '": must be '
+  $S1 = optionsToString(options)
   error .= $S1
   tcl_error error
 .end
@@ -187,7 +201,7 @@
   $S1 .= ' "-'
   $S1 .= arg
   $S1 .= '": must be '
-  $S2 = __switches_to_string(switches)
+  $S2 = switchesToString(switches)
   $S1 .= $S2
   tcl_error $S1
 loop_next:
@@ -204,7 +218,7 @@
   .return (results)
 .end
 
-.sub __options_to_string
+.sub optionsToString
   .param pmc options
 
   # uncomment this if folks start passing in un-ordered lists...
@@ -240,8 +254,8 @@
   .return (error)
 .end
 
-# Similar to __option_to_string. Refactor??
-.sub __switches_to_string
+# Similar to optionsToString. Refactor??
+.sub switchesToString
   .param pmc switches
 
   # uncomment this if folks start passing in un-ordered lists...

Modified: branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir        
(original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/string_to_list.pir        Thu Jul 
24 13:41:24 2008
@@ -53,7 +53,7 @@
   tcl_error 'missing value to go with key'
 .end
 
-.sub __stringToDict
+.sub stringToDict
   .param string str
 
   .local pmc list

Modified: branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir        (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/tcllib.pir        Thu Jul 24 
13:41:24 2008
@@ -27,7 +27,6 @@
 
 # library files (HLL: _Tcl)
 .include 'languages/tcl/runtime/conversions.pir'
-.include 'languages/tcl/runtime/list_to_string.pir'
 .include 'languages/tcl/runtime/string_to_list.pir'
 .include 'languages/tcl/runtime/variables.pir'
 .include 'languages/tcl/runtime/options.pir'
@@ -242,7 +241,7 @@
   set_hll_global 'colons', colons
 
   # register the TCL compiler.
-  $P1 = get_root_global ['_tcl'], '__script'
+  $P1 = get_root_global ['_tcl'], 'compileTcl'
   compreg 'TCL', $P1
 
   # Setup a global to keep a unique id for compiled subs.

Modified: branches/gsoc_pdd09/languages/tcl/runtime/variables.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/runtime/variables.pir     (original)
+++ branches/gsoc_pdd09/languages/tcl/runtime/variables.pir     Thu Jul 24 
13:41:24 2008
@@ -307,7 +307,7 @@
   absolute = 1
 global_var:
   depth += 2
-  ns = __namespace(name, depth)
+  ns = splitNamespace(name, depth)
   $S0 = pop ns
   $S0 = '$' . $S0
 
@@ -393,7 +393,7 @@
 
 global_var:
   depth += 2
-  ns = __namespace(name, depth)
+  ns = splitNamespace(name, depth)
   name = pop ns
   name = '$' . name
 

Modified: branches/gsoc_pdd09/languages/tcl/src/builtin/expr.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/builtin/expr.pir      (original)
+++ branches/gsoc_pdd09/languages/tcl/src/builtin/expr.pir      Thu Jul 24 
13:41:24 2008
@@ -27,12 +27,12 @@
 end:
   arg = join ' ', raw_args
 
-  .local pmc __expr
-  __expr = get_root_global ['_tcl'], '__expr'
+  .local pmc compileExpr
+  compileExpr = get_root_global ['_tcl'], 'compileExpr'
 
   # make sure errors happen at runtime
   push_eh exception
-    ($P0, $S0) = __expr(arg, 'pir_only'=>1)
+    ($P0, $S0) = compileExpr(arg, 'pir_only'=>1)
   pop_eh
   pir = new 'CodeString'
   pir .= $P0

Modified: branches/gsoc_pdd09/languages/tcl/src/builtin/lrange.tmt
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/builtin/lrange.tmt    (original)
+++ branches/gsoc_pdd09/languages/tcl/src/builtin/lrange.tmt    Thu Jul 24 
13:41:24 2008
@@ -1,11 +1,11 @@
 [lrange list:list first last]
 
-  .local pmc __index
-  __index = get_root_global ['_tcl'], '__index'
+  .local pmc getIndex
+  getIndex = get_root_global ['_tcl'], 'getIndex'
 
   .local int from, to
-  from = __index($first, $list)
-  to   = __index($last,  $list)
+  from = getIndex($first, $list)
+  to   = getIndex($last,  $list)
 
   if from < 0 goto set_first
 have_first:

Modified: branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir (original)
+++ branches/gsoc_pdd09/languages/tcl/src/grammar/expr/past.pir Thu Jul 24 
13:41:24 2008
@@ -29,13 +29,13 @@
 
 .namespace [ 'PAST' ]
 
-=item C<__onload()>
+=item C<onload()>
 
 Creates the C<PAST::*> classes.
 
 =cut
 
-.sub '__onload' :load
+.sub 'onload' :load :anon
     .local pmc base
     $P0 = get_class 'Hash'
     base = subclass $P0, 'PAST::Node'
@@ -66,7 +66,7 @@
 
 =over 4
 
-=item C<__init()>
+=item C<init()>
 
 Initializes a new C<PAST::Node> object.
 

Modified: branches/gsoc_pdd09/languages/tcl/src/pmc/tcldict.pmc
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/pmc/tcldict.pmc       (original)
+++ branches/gsoc_pdd09/languages/tcl/src/pmc/tcldict.pmc       Thu Jul 24 
13:41:24 2008
@@ -34,27 +34,27 @@
 
 =item C<STRING *get_string()>
 
-Returns the dict as a string
+Returns the dict as a string. Take advantage of the heavy lifting already
+present in TclList.
 
 =cut
 
 */
 
     VTABLE STRING* get_string() {
-        PMC *dictToString, *namespace;
-        STRING *_tcl_namespace, *sub;
+        PMC *list, *iterator, *value;
+        STRING *key;
 
-        _tcl_namespace = string_from_cstring(INTERP, "_tcl", 4);
-        sub            = string_from_cstring(INTERP, "dictToString", 14);
-
-        namespace = INTERP->root_namespace;
-        namespace = VTABLE_get_pmc_keyed_str(INTERP, namespace, 
_tcl_namespace);
-        dictToString = VTABLE_get_pmc_keyed_str(INTERP, namespace, sub);
-
-        CONTEXT(interp)->constants =
-          PMC_sub(dictToString)->seg->const_table->constants;
-        return (STRING *)Parrot_runops_fromc_args(INTERP, dictToString, "SP", 
SELF);
+        list = pmc_new(INTERP, pmc_type(INTERP, CONST_STRING(INTERP, 
"TclList")));
+        iterator = SELF.get_iter();
 
+        while (VTABLE_get_bool(INTERP, iterator)) {
+                key = VTABLE_shift_string(INTERP, iterator);
+                VTABLE_push_string(INTERP, list, key);
+                value = VTABLE_get_pmc_keyed_str(INTERP, SELF, key);
+                VTABLE_push_string(INTERP, list, VTABLE_get_string(INTERP, 
value));
+        }
+        return VTABLE_get_string(INTERP, list);
     }
 }
 

Modified: branches/gsoc_pdd09/languages/tcl/src/tclsh.pir
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/src/tclsh.pir     (original)
+++ branches/gsoc_pdd09/languages/tcl/src/tclsh.pir     Thu Jul 24 13:41:24 2008
@@ -42,8 +42,8 @@
   tcl_interactive = new 'Integer'
   store_global '$tcl_interactive', tcl_interactive
 
-  .local pmc __script
-  __script = get_root_global ['_tcl'], '__script'
+  .local pmc compileTcl
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
 
   .local pmc get_options
   get_options = new 'Getopt::Obj'
@@ -82,19 +82,19 @@
   .local int level
   level = 1
 input_loop:
-  $P0 = __prompt(level, readlineInd)
+  $P0 = prompt(level, readlineInd)
   if null $P0 goto done
   $S0 = $P0
   $S0 .= "\n" # add back in the newline the prompt chomped
   input_line .= $S0
-  # could probably avoid calling __script 2x here...
+  # could probably avoid calling compileTcl 2x here...
   unless dump_only goto execute_line
   .local string _pir
-  _pir = __script(input_line, 'pir_only'=>1, 'bsnl'=>1)
+  _pir = compileTcl(input_line, 'pir_only'=>1, 'bsnl'=>1)
   say _pir
 execute_line:
   push_eh loop_error
-    $P2 = __script(input_line)
+    $P2 = compileTcl(input_line)
     retval = $P2()
   pop_eh
   # print out the result of the evaluation.
@@ -137,14 +137,14 @@
   .set_tcl_argv()
   unless dump_only goto run_file
   push_eh file_error
-    ($S0,$I0) = __script(contents, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1)
+    ($S0,$I0) = compileTcl(contents, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1)
   pop_eh
   print $S0
   goto done
 
 run_file:
   push_eh file_error
-    $P2 = __script(contents, 'bsnl' => 1)
+    $P2 = compileTcl(contents, 'bsnl' => 1)
     $P2()
   pop_eh
   goto done
@@ -161,14 +161,14 @@
   .local string tcl_code
   tcl_code = opt['e']
   if dump_only goto oneliner_dump
-  $P3 = __script(tcl_code)
+  $P3 = compileTcl(tcl_code)
   push_eh file_error
     $P3()
   pop_eh
   goto done
 
 oneliner_dump:
-  ($S0,$I0) = __script(tcl_code, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1)
+  ($S0,$I0) = compileTcl(tcl_code, 'pir_only'=>1, 'bsnl'=>1, 'wrapper'=>1)
   print $S0
 
 done:
@@ -198,7 +198,7 @@
   .rethrow()
 .end
 
-.sub __prompt
+.sub prompt
   .param int level
   .param int readlineInd
 
@@ -219,15 +219,15 @@
   $S0 = level
   varname .= $S0
 
-  .local pmc __script
-  __script = get_root_global ['_tcl'], '__script'
+  .local pmc compileTcl
+  compileTcl = get_root_global ['_tcl'], 'compileTcl'
 
   # XXX Should trap the printed output here, and then display
   # it using the readilne prompt, like everything else.
   # XXX Should be testing this
   push_eh no_prompt
     $P0 = find_global varname
-    $P2 = __script($P0)
+    $P2 = compileTcl($P0)
     $P2()
   pop_eh
 

Modified: branches/gsoc_pdd09/languages/tcl/t/cmd_binary.t
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/t/cmd_binary.t    (original)
+++ branches/gsoc_pdd09/languages/tcl/t/cmd_binary.t    Thu Jul 24 13:41:24 2008
@@ -10,7 +10,7 @@
 __DATA__
 
 source lib/test_more.tcl
-plan 2 ; # was 14, skipping the last 12 tests.
+plan 14
 
 eval_is {binary} {wrong # args: should be "binary option ?arg arg ...?"} \
   {binary: no args}
@@ -18,23 +18,20 @@
 eval_is {binary foo} {bad option "foo": must be format or scan} \
   {binary: bad subcommand}
 
-
 # we test the default precision (which is special) elsewhere
 # so just set a precision to work around a bug
 set tcl_precision 17
 
-exit; # $d isn't getting set here, which kills the rest of the tests...
-
 binary scan [binary format dccc -1.3 6 7 8] dcc* d c c*
-is $d    -1.3  {binary: reversible d}
-is $c       6  {binary: reversible c}
-is ${c*} {7 8} {binary: scan [format cc] c*}
+is $d    -1.3  {binary: reversible d} {TODO borked}
+is $c       6  {binary: reversible c} {TODO borked}
+is ${c*} {7 8} {binary: scan [format cc] c*} {TODO borked}
 
 binary scan [binary format f -1.3] f f
-is $f -1.2999999523162842  {binary: reversible f}
+is $f -1.2999999523162842  {binary: reversible f} {TODO borked}
 
 binary scan [binary format n 9] n n
-is $n 9 {binary: reversible n}
+is $n 9 {binary: reversible n} {TODO borked}
 
 binary scan {foo bar} aa* first rest
 is [list $first $rest] {f {oo bar}} {binary: scan aa*}
@@ -51,4 +48,4 @@
 is $string2 b   {binary: format a4a, scan a3ca}
 
 # segfault misc.
-is [proc a {} { binary scan \x80 d joe } ; a] {} {BOOM?}
+is [proc a {} { binary scan \x80 d joe } ; a] {0} {BOOM?} {TODO borked}

Modified: branches/gsoc_pdd09/languages/tcl/tools/gen_inline.pl
==============================================================================
--- branches/gsoc_pdd09/languages/tcl/tools/gen_inline.pl       (original)
+++ branches/gsoc_pdd09/languages/tcl/tools/gen_inline.pl       Thu Jul 24 
13:41:24 2008
@@ -37,11 +37,11 @@
 
     # type     subroutine
     bool    => 'toBoolean',
-    channel => '__channel',
-    expr    => '__expr',
+    channel => 'getChannel',
+    expr    => 'compileExpr',
     int     => 'toInteger',
     list    => 'toList',
-    script  => '__script',
+    script  => 'compileTcl',
     var     => 'readVar',
 );
 

Modified: branches/gsoc_pdd09/src/libnci_test.def
==============================================================================
--- branches/gsoc_pdd09/src/libnci_test.def     (original)
+++ branches/gsoc_pdd09/src/libnci_test.def     Thu Jul 24 13:41:24 2008
@@ -32,6 +32,8 @@
     nci_vP
     nci_vpii
     nci_vv
+    nci_vVi
+    nci_vp
     nci_cb_C1
     nci_cb_C2
     nci_cb_C3

Modified: branches/gsoc_pdd09/src/nci_test.c
==============================================================================
--- branches/gsoc_pdd09/src/nci_test.c  (original)
+++ branches/gsoc_pdd09/src/nci_test.c  Thu Jul 24 13:41:24 2008
@@ -58,6 +58,10 @@
     int w, h;
 } Rect_Like;
 
+typedef struct Opaque {
+    int x;
+} Opaque;
+
 /* Function declarations.
 
 *** If you add a new test function here,
@@ -98,6 +102,8 @@
 PARROT_API void   nci_vP(void *);
 PARROT_API void   nci_vpii(Outer *, int, int);
 PARROT_API void   nci_vv(void);
+PARROT_API void   nci_vVi(Opaque**, int);
+PARROT_API void   nci_vp(Opaque*);
 
 
 /* Declarations for callback tests */
@@ -1044,6 +1050,47 @@
     nci_dlvar_int *= 3;
 }
 
+/*
+
+=item C<PARROT_API void
+nci_vVi(Opaque**, int)>
+
+Test an NCI opaque struct out value.
+
+=cut
+
+*/
+
+PARROT_API void
+nci_vVi(Opaque **outOpaque, int x)
+{
+    static Opaque opaque;
+    opaque.x = x;
+    *outOpaque = &opaque;
+}
+
+/*
+
+=item C<PARROT_API int
+nci_vp(Opaque*)>
+
+Test that a previously generated opaque struct gets passed back
+to an NCI function correctly.
+
+=cut
+
+*/
+
+PARROT_API void
+nci_vp(Opaque *inOpaque)
+{
+    if (inOpaque)
+        printf("got %d\n", inOpaque->x);
+    else
+        printf("got null");
+}
+
+
 #ifdef TEST
 
 char l2 = 4;

Modified: branches/gsoc_pdd09/t/pmc/nci.t
==============================================================================
--- branches/gsoc_pdd09/t/pmc/nci.t     (original)
+++ branches/gsoc_pdd09/t/pmc/nci.t     Thu Jul 24 13:41:24 2008
@@ -6,7 +6,7 @@
 use warnings;
 use lib qw( . lib ../lib ../../lib );
 use Test::More;
-use Parrot::Test tests => 65;
+use Parrot::Test tests => 66;
 use Parrot::Config qw(%PConfig);
 
 =head1 NAME
@@ -2645,6 +2645,29 @@
 3
 OUTPUT
 
+pir_output_is( << 'CODE', << 'OUTPUT', "nci_vVi - void** out parameter" );
+.sub test :main
+    .local string library_name
+    library_name = 'libnci_test'
+    .local pmc libnci_test
+    libnci_test = loadlib  library_name
+
+    .local pmc nci_vVi
+    nci_vVi = dlfunc libnci_test, "nci_vVi", "vVi"
+
+    .local pmc nci_vp
+    nci_vp = dlfunc libnci_test, "nci_vp", "vp"
+
+    .local pmc opaque
+    opaque = new 'Pointer'
+    $I0 = 10
+    nci_vVi(opaque, $I0)
+    nci_vp(opaque)
+.end
+CODE
+got 10
+OUTPUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Modified: branches/gsoc_pdd09/tools/build/nativecall.pl
==============================================================================
--- branches/gsoc_pdd09/tools/build/nativecall.pl       (original)
+++ branches/gsoc_pdd09/tools/build/nativecall.pl       Thu Jul 24 13:41:24 2008
@@ -82,6 +82,7 @@
     B   => "void **",
     L   => "long *",
     T   => "char **",
+    V   => "void **",
     '@' => "PMC *",           # slurpy array
 );
 
@@ -186,6 +187,7 @@
     N   => "N",
     B   => "S",
     v   => "v",
+    V   => "P",
     J   => "",
     '@' => '@',
 );
@@ -439,6 +441,11 @@
         push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
         return "PMC_data(t_$temp_num)";
     };
+    /V/ && do {
+        push @{$temps_ref},          "PMC *t_$temp_num;";
+        push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
+        return "(void**)&PMC_data(t_$temp_num)";
+    };
     /i/ && do {
         push @{$temps_ref},          "int t_$temp_num;";
         push @{$extra_preamble_ref}, "t_$temp_num = (int)GET_NCI_I($reg_num);";

<Prev in Thread] Current Thread [Next in Thread>
  • [svn:parrot] r29730 - in branches/gsoc_pdd09: . config/gen/call_list config/init/hints languages/perl6/t languages/tcl/config/makefiles languages/tcl/lib languages/tcl/runtime languages/tcl/runtime/builtin languages/tcl/src languages/tcl/src/builtin languages/tcl/src/grammar/expr languages/tcl/src/pmc languages/tcl/t languages/tcl/tools src t/pmc tools/build, Whiteknight <=