|
|
Author: coke
Date: Wed Jul 30 21:28:21 2008
New Revision: 29902
Modified:
trunk/languages/tcl/runtime/builtin/array.pir
trunk/languages/tcl/runtime/builtin/binary.pir
trunk/languages/tcl/runtime/builtin/clock.pir
trunk/languages/tcl/runtime/builtin/dict.pir
trunk/languages/tcl/runtime/builtin/encoding.pir
trunk/languages/tcl/runtime/builtin/file.pir
trunk/languages/tcl/runtime/builtin/info.pir
trunk/languages/tcl/runtime/builtin/lsearch.pir
trunk/languages/tcl/runtime/builtin/namespace.pir
trunk/languages/tcl/runtime/builtin/regexp.pir
trunk/languages/tcl/runtime/builtin/regsub.pir
trunk/languages/tcl/runtime/builtin/string.pir
trunk/languages/tcl/runtime/builtin/subst.pir
Log:
[tcl] setup some PMCs once at runtime instead of every time a function is
invoked. (Ideally, create them as constants at build time.)
Modified: trunk/languages/tcl/runtime/builtin/array.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/array.pir (original)
+++ trunk/languages/tcl/runtime/builtin/array.pir Wed Jul 30 21:28:21 2008
@@ -18,21 +18,11 @@
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- options[0] = 'anymore'
- options[1] = 'donesearch'
- options[2] = 'exists'
- options[3] = 'get'
- options[4] = 'names'
- options[5] = 'nextelement'
- options[6] = 'set'
- options[7] = 'size'
- options[8] = 'startsearch'
- options[9] = 'statistics'
- options[10] = 'unset'
+ options = get_root_global ['_tcl'; 'helpers'; 'array'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
@@ -451,6 +441,24 @@
.return (retval)
.end
+.sub 'anon' :load :anon
+ .local pmc options
+ options = new 'TclList'
+ options[0] = 'anymore'
+ options[1] = 'donesearch'
+ options[2] = 'exists'
+ options[3] = 'get'
+ options[4] = 'names'
+ options[5] = 'nextelement'
+ options[6] = 'set'
+ options[7] = 'size'
+ options[8] = 'startsearch'
+ options[9] = 'statistics'
+ options[10] = 'unset'
+
+ set_root_global ['_tcl'; 'helpers'; 'array'], 'options', options
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/binary.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/binary.pir (original)
+++ trunk/languages/tcl/runtime/builtin/binary.pir Wed Jul 30 21:28:21 2008
@@ -13,12 +13,11 @@
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- push options, 'format'
- push options, 'scan'
+ options = get_root_global ['_tcl'; 'helpers'; 'binary'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
@@ -94,6 +93,14 @@
tcl_error 'wrong # args: should be "binary scan value formatString
?varName varName ...?"'
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'format'
+ push options, 'scan'
+
+ set_root_global ['_tcl'; 'helpers'; 'binary'], 'options', options
+.end
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/clock.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/clock.pir (original)
+++ trunk/languages/tcl/runtime/builtin/clock.pir Wed Jul 30 21:28:21 2008
@@ -13,16 +13,11 @@
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- push options, 'add'
- push options, 'clicks'
- push options, 'format'
- push options, 'microseconds'
- push options, 'milliseconds'
- push options, 'scan'
- push options, 'seconds'
+ options = get_root_global ['_tcl'; 'helpers'; 'clock'], 'options'
+
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
@@ -80,6 +75,20 @@
tcl_error 'wrong # args: should be "clock seconds"'
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'add'
+ push options, 'clicks'
+ push options, 'format'
+ push options, 'microseconds'
+ push options, 'milliseconds'
+ push options, 'scan'
+ push options, 'seconds'
+
+ set_root_global ['_tcl'; 'helpers'; 'clock'], 'options', options
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/dict.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/dict.pir (original)
+++ trunk/languages/tcl/runtime/builtin/dict.pir Wed Jul 30 21:28:21 2008
@@ -6,36 +6,19 @@
.local pmc retval
- $I3 = argv
- unless $I3 goto no_args
+ .local int argc
+ argc = elements argv
+ unless argc goto no_args
.local string subcommand_name
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- options[0] = 'append'
- options[1] = 'create'
- options[2] = 'exists'
- options[3] = 'filter'
- options[4] = 'for'
- options[5] = 'get'
- options[6] = 'incr'
- options[7] = 'info'
- options[8] = 'keys'
- options[9] = 'lappend'
- options[10] = 'merge'
- options[11] = 'remove'
- options[12] = 'replace'
- options[13] = 'set'
- options[14] = 'size'
- options[15] = 'unset'
- options[16] = 'update'
- options[17] = 'values'
- options[18] = 'with'
+ options = get_root_global ['_tcl'; 'helpers'; 'dict'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name, 'subcommand')
@@ -1049,7 +1032,31 @@
tcl_error 'wrong # args: should be "dict with dictVar ?key ...? script"'
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ options[0] = 'append'
+ options[1] = 'create'
+ options[2] = 'exists'
+ options[3] = 'filter'
+ options[4] = 'for'
+ options[5] = 'get'
+ options[6] = 'incr'
+ options[7] = 'info'
+ options[8] = 'keys'
+ options[9] = 'lappend'
+ options[10] = 'merge'
+ options[11] = 'remove'
+ options[12] = 'replace'
+ options[13] = 'set'
+ options[14] = 'size'
+ options[15] = 'unset'
+ options[16] = 'update'
+ options[17] = 'values'
+ options[18] = 'with'
+ set_root_global ['_tcl'; 'helpers'; 'dict'], 'options', options
+.end
# Local Variables:
# mode: pir
Modified: trunk/languages/tcl/runtime/builtin/encoding.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/encoding.pir (original)
+++ trunk/languages/tcl/runtime/builtin/encoding.pir Wed Jul 30 21:28:21 2008
@@ -6,22 +6,19 @@
.local pmc retval
- $I3 = argv
- unless $I3 goto no_args
+ .local int argc
+ argc = elements argv
+ unless argc goto no_args
.local string subcommand_name
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- push options, 'convertfrom'
- push options, 'convertto'
- push options, 'dirs'
- push options, 'names'
- push options, 'system'
+ options = get_root_global ['_tcl'; 'helpers'; 'encoding'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
@@ -116,6 +113,18 @@
tcl_error 'wrong # args: should be "encoding system ?encoding?"'
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'convertfrom'
+ push options, 'convertto'
+ push options, 'dirs'
+ push options, 'names'
+ push options, 'system'
+
+ set_root_global ['_tcl'; 'helpers'; 'encoding'], 'options', options
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/file.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/file.pir (original)
+++ trunk/languages/tcl/runtime/builtin/file.pir Wed Jul 30 21:28:21 2008
@@ -13,43 +13,11 @@
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- push options, 'atime'
- push options, 'attributes'
- push options, 'channels'
- push options, 'copy'
- push options, 'delete'
- push options, 'dirname'
- push options, 'executable'
- push options, 'exists'
- push options, 'extension'
- push options, 'isdirectory'
- push options, 'isfile'
- push options, 'join'
- push options, 'link'
- push options, 'lstat'
- push options, 'mtime'
- push options, 'mkdir'
- push options, 'nativename'
- push options, 'normalize'
- push options, 'owned'
- push options, 'pathtype'
- push options, 'readable'
- push options, 'readlink'
- push options, 'rename'
- push options, 'rootname'
- push options, 'separator'
- push options, 'size'
- push options, 'split'
- push options, 'stat'
- push options, 'system'
- push options, 'tail'
- push options, 'type'
- push options, 'volumes'
- push options, 'writable'
+ options = get_root_global ['_tcl'; 'helpers'; 'file'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
@@ -600,6 +568,46 @@
tcl_error 'wrong # args: should be "file volumes"'
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'atime'
+ push options, 'attributes'
+ push options, 'channels'
+ push options, 'copy'
+ push options, 'delete'
+ push options, 'dirname'
+ push options, 'executable'
+ push options, 'exists'
+ push options, 'extension'
+ push options, 'isdirectory'
+ push options, 'isfile'
+ push options, 'join'
+ push options, 'link'
+ push options, 'lstat'
+ push options, 'mtime'
+ push options, 'mkdir'
+ push options, 'nativename'
+ push options, 'normalize'
+ push options, 'owned'
+ push options, 'pathtype'
+ push options, 'readable'
+ push options, 'readlink'
+ push options, 'rename'
+ push options, 'rootname'
+ push options, 'separator'
+ push options, 'size'
+ push options, 'split'
+ push options, 'stat'
+ push options, 'system'
+ push options, 'tail'
+ push options, 'type'
+ push options, 'volumes'
+ push options, 'writable'
+
+ set_root_global ['_tcl'; 'helpers'; 'file'], 'options', options
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/info.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/info.pir (original)
+++ trunk/languages/tcl/runtime/builtin/info.pir Wed Jul 30 21:28:21 2008
@@ -12,32 +12,11 @@
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- push options, 'args'
- push options, 'body'
- push options, 'cmdcount'
- push options, 'commands'
- push options, 'complete'
- push options, 'default'
- push options, 'exists'
- push options, 'frame'
- push options, 'functions'
- push options, 'globals'
- push options, 'hostname'
- push options, 'level'
- push options, 'library'
- push options, 'loaded'
- push options, 'locals'
- push options, 'nameofexecutable'
- push options, 'patchlevel'
- push options, 'procs'
- push options, 'script'
- push options, 'sharedlibextension'
- push options, 'tclversion'
- push options, 'vars'
+ options = get_root_global ['_tcl'; 'helpers'; 'info'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
@@ -563,6 +542,35 @@
.return(0)
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'args'
+ push options, 'body'
+ push options, 'cmdcount'
+ push options, 'commands'
+ push options, 'complete'
+ push options, 'default'
+ push options, 'exists'
+ push options, 'frame'
+ push options, 'functions'
+ push options, 'globals'
+ push options, 'hostname'
+ push options, 'level'
+ push options, 'library'
+ push options, 'loaded'
+ push options, 'locals'
+ push options, 'nameofexecutable'
+ push options, 'patchlevel'
+ push options, 'procs'
+ push options, 'script'
+ push options, 'sharedlibextension'
+ push options, 'tclversion'
+ push options, 'vars'
+
+ set_root_global ['_tcl'; 'helpers'; 'info'], 'options', options
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/lsearch.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/lsearch.pir (original)
+++ trunk/languages/tcl/runtime/builtin/lsearch.pir Wed Jul 30 21:28:21 2008
@@ -5,24 +5,7 @@
.param pmc argv :slurpy
.local pmc options
- options = new 'TclList'
- push options, 'all'
- push options, 'ascii'
- push options, 'decreasing'
- push options, 'dictionary'
- push options, 'exact'
- push options, 'glob'
- push options, 'increasing'
- push options, 'index'
- push options, 'inline'
- push options, 'integer'
- push options, 'nocase'
- push options, 'not'
- push options, 'real'
- push options, 'regexp'
- push options, 'sorted'
- push options, 'start'
- push options, 'subindices'
+ options = get_root_global ['_tcl'; 'helpers'; 'lsearch'], 'options'
.local pmc select_switches, switches
select_switches = get_root_global ['_tcl'], 'select_switches'
@@ -119,6 +102,31 @@
tcl_error 'wrong # args: should be "lsearch ?options? list pattern"'
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'all'
+ push options, 'ascii'
+ push options, 'decreasing'
+ push options, 'dictionary'
+ push options, 'exact'
+ push options, 'glob'
+ push options, 'increasing'
+ push options, 'index'
+ push options, 'inline'
+ push options, 'integer'
+ push options, 'nocase'
+ push options, 'not'
+ push options, 'real'
+ push options, 'regexp'
+ push options, 'sorted'
+ push options, 'start'
+ push options, 'subindices'
+
+ set_root_global ['_tcl'; 'helpers'; 'lsearch'], 'options', options
+.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/namespace.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/namespace.pir (original)
+++ trunk/languages/tcl/runtime/builtin/namespace.pir Wed Jul 30 21:28:21 2008
@@ -25,29 +25,11 @@
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- options[0] = 'children'
- options[1] = 'code'
- options[2] = 'current'
- options[3] = 'delete'
- options[4] = 'ensemble'
- options[5] = 'eval'
- options[6] = 'exists'
- options[7] = 'export'
- options[8] = 'forget'
- options[9] = 'import'
- options[10] = 'inscope'
- options[11] = 'origin'
- options[12] = 'parent'
- options[13] = 'path'
- options[14] = 'qualifiers'
- options[15] = 'tail'
- options[16] = 'unknown'
- options[17] = 'upvar'
- options[18] = 'which'
+ options = get_root_global ['_tcl'; 'helpers'; 'namespace'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
@@ -476,6 +458,32 @@
.return ('')
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ options[0] = 'children'
+ options[1] = 'code'
+ options[2] = 'current'
+ options[3] = 'delete'
+ options[4] = 'ensemble'
+ options[5] = 'eval'
+ options[6] = 'exists'
+ options[7] = 'export'
+ options[8] = 'forget'
+ options[9] = 'import'
+ options[10] = 'inscope'
+ options[11] = 'origin'
+ options[12] = 'parent'
+ options[13] = 'path'
+ options[14] = 'qualifiers'
+ options[15] = 'tail'
+ options[16] = 'unknown'
+ options[17] = 'upvar'
+ options[18] = 'which'
+
+ set_root_global ['_tcl'; 'helpers'; 'namespace'], 'options', options
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/regexp.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/regexp.pir (original)
+++ trunk/languages/tcl/runtime/builtin/regexp.pir Wed Jul 30 21:28:21 2008
@@ -9,17 +9,7 @@
if argc < 2 goto badargs
.local pmc options
- options = new 'TclList'
- push options, 'all'
- push options, 'about'
- push options, 'indices'
- push options, 'inline'
- push options, 'expanded' # RT#40774: use tcl-regexps
- push options, 'line'
- push options, 'linestop'
- push options, 'lineanchor'
- push options, 'nocase'
- push options, 'start'
+ options = get_root_global ['_tcl'; 'helpers'; 'regexp'], 'options'
.local pmc select_switches, switches
select_switches = get_root_global ['_tcl'], 'select_switches'
@@ -140,6 +130,23 @@
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'all'
+ push options, 'about'
+ push options, 'indices'
+ push options, 'inline'
+ push options, 'expanded' # RT#40774: use tcl-regexps
+ push options, 'line'
+ push options, 'linestop'
+ push options, 'lineanchor'
+ push options, 'nocase'
+ push options, 'start'
+
+ set_root_global ['_tcl'; 'helpers'; 'regexp'], 'options', options
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/regsub.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/regsub.pir (original)
+++ trunk/languages/tcl/runtime/builtin/regsub.pir Wed Jul 30 21:28:21 2008
@@ -11,14 +11,7 @@
.local string expression, target, subSpec, original_target
.local pmc options
- options = new 'TclList'
- push options, 'all'
- push options, 'nocase'
- push options, 'expanded' # RT#40774: use tcl-regexps
- push options, 'line'
- push options, 'linestop'
- push options, 'lineanchor'
- push options, 'start'
+ options = get_root_global ['_tcl'; 'helpers'; 'regsub'], 'options'
.local pmc select_switches, switches
select_switches = get_root_global ['_tcl'], 'select_switches'
@@ -120,7 +113,20 @@
badargs:
tcl_error 'wrong # args: should be "regsub ?switches? exp string subSpec
?varName?"'
+.end
+
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'all'
+ push options, 'nocase'
+ push options, 'expanded' # RT#40774: use tcl-regexps
+ push options, 'line'
+ push options, 'linestop'
+ push options, 'lineanchor'
+ push options, 'start'
+ set_root_global ['_tcl'; 'helpers'; 'regsub'], 'options', options
.end
# Local Variables:
Modified: trunk/languages/tcl/runtime/builtin/string.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/string.pir (original)
+++ trunk/languages/tcl/runtime/builtin/string.pir Wed Jul 30 21:28:21 2008
@@ -14,36 +14,14 @@
subcommand_name = shift argv
.local pmc options
- options = new 'TclList'
- push options, 'bytelength'
- push options, 'compare'
- push options, 'equal'
- push options, 'first'
- push options, 'index'
- push options, 'is'
- push options, 'last'
- push options, 'length'
- push options, 'map'
- push options, 'match'
- push options, 'range'
- push options, 'repeat'
- push options, 'replace'
- push options, 'reverse'
- push options, 'tolower'
- push options, 'toupper'
- push options, 'totitle'
- push options, 'trim'
- push options, 'trimleft'
- push options, 'trimright'
- push options, 'wordend'
- push options, 'wordstart'
+ options = get_root_global ['_tcl'; 'helpers'; 'string'], 'options'
.local pmc select_option
select_option = get_root_global ['_tcl'], 'select_option'
+
.local string canonical_subcommand
canonical_subcommand = select_option(options, subcommand_name)
-
.local pmc subcommand_proc
null subcommand_proc
@@ -1155,6 +1133,36 @@
tcl_error 'wrong # args: should be "string wordstart string index"'
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ push options, 'bytelength'
+ push options, 'compare'
+ push options, 'equal'
+ push options, 'first'
+ push options, 'index'
+ push options, 'is'
+ push options, 'last'
+ push options, 'length'
+ push options, 'map'
+ push options, 'match'
+ push options, 'range'
+ push options, 'repeat'
+ push options, 'replace'
+ push options, 'reverse'
+ push options, 'tolower'
+ push options, 'toupper'
+ push options, 'totitle'
+ push options, 'trim'
+ push options, 'trimleft'
+ push options, 'trimright'
+ push options, 'wordend'
+ push options, 'wordstart'
+
+ set_root_global [ '_tcl'; 'helpers'; 'string' ], 'options', options
+.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: trunk/languages/tcl/runtime/builtin/subst.pir
==============================================================================
--- trunk/languages/tcl/runtime/builtin/subst.pir (original)
+++ trunk/languages/tcl/runtime/builtin/subst.pir Wed Jul 30 21:28:21 2008
@@ -5,10 +5,7 @@
.param pmc argv :slurpy
.local pmc options
- options = new 'TclList'
- options[0] = 'nobackslashes'
- options[1] = 'nocommands'
- options[2] = 'novariables'
+ options = get_root_global ['_tcl'; 'helpers'; 'subst'], 'options'
.local pmc select_switches, switches
select_switches = get_root_global ['_tcl'], 'select_switches'
@@ -127,6 +124,17 @@
tcl_error $S0
.end
+.sub 'anon' :anon :load
+ .local pmc options
+ options = new 'TclList'
+ options[0] = 'nobackslashes'
+ options[1] = 'nocommands'
+ options[2] = 'novariables'
+
+ set_root_global ['_tcl'; 'helpers'; 'subst'], 'options', options
+.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
|
|