This patch adds a gst-profile tool to use the profiler more easily. Bug reports (Derek, can you reproduce the filein thing?) are welcome.
Paolo
commit 876ba99d2504cf3ab38958e775a0b7a93c059b53 Author: Paolo Bonzini <[email protected]> Date: Mon Feb 23 09:55:26 2009 +0100 add gst-profile. 2009-02-22 Paolo Bonzini <[email protected]> * scripts/Profile.st: New. * gst-tool.c: Add its options. diff --git a/ChangeLog b/ChangeLog index 86914c8..e053802 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2009-02-22 Paolo Bonzini <[email protected]> + + * scripts/Profile.st: New. + * gst-tool.c: Add its options. + 2009-02-19 Paolo Bonzini <[email protected]> * kernel/CompildCode.st: Add #method. diff --git a/Makefile.am b/Makefile.am index 95f29eb..374d31c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -119,7 +119,7 @@ gst_tool_DEPENDENCIES = libgst/libgst.la lib-src/library.la gst_tool_LDFLAGS = -export-dynamic $(RELOC_LDFLAGS) GST_EXTRA_TOOLS = gst-reload gst-sunit gst-blox gst-package gst-convert \ - gst-doc gst-remote + gst-doc gst-remote gst-profile uninstall-local:: @for i in gst-load $(GST_EXTRA_TOOLS); do \ diff --git a/gst-tool.c b/gst-tool.c index 1d6a464..8599eb6 100644 --- a/gst-tool.c +++ b/gst-tool.c @@ -135,6 +135,13 @@ struct tool tools[] = { -I|--image-file: --kernel-directory:", NULL }, + { + "gst-profile", "scripts/Profile.st", + "-f|--file: -e|--eval: -o|--output: -h|--help --version \ + --no-separate-blocks", + NULL + }, + { NULL, NULL, NULL, NULL } }; diff --git a/scripts/Profile.st b/scripts/Profile.st new file mode 100644 index 0000000..0d92036 --- /dev/null +++ b/scripts/Profile.st @@ -0,0 +1,122 @@ +"====================================================================== +| +| GNU Smalltalk profiling tool +| +| + ======================================================================" + + +"====================================================================== +| +| Copyright 2009 Free Software Foundation, Inc. +| Written by Paolo Bonzini. +| +| This file is part of GNU Smalltalk. +| +| GNU Smalltalk is free software; you can redistribute it and/or modify it +| under the terms of the GNU General Public License as published by the Free +| Software Foundation; either version 2, or (at your option) any later version. +| +| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT +| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +| details. +| +| You should have received a copy of the GNU General Public License along with +| GNU Smalltalk; see the file COPYING. If not, write to the Free Software +| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +| + ======================================================================" + +PackageLoader fileInPackage: 'ProfileTools'. +DLD addLibrary: 'libc'. + +SystemDictionary extend [ + SmalltalkArgv := OrderedCollection new. +] + +| helpString output profiler profilerClass last | +commands := OrderedCollection new. +output := nil. +profilerClass := CallGraphProfiler. + +helpString := +'Usage: + gst-profile [ flag ... ] [FILE ARGS] + +Options: + -f --file=FILE file in FILE + -e --eval=CODE evaluate CODE + -o --output=FILE output file for callgrind_annotate + -h --help show this message + --no-separate-blocks do not track blocks separately + --version print version information and exit + +FILE is always parsed, even if --file or --eval are used. It is also +always parsed last. Use /dev/null to pass arguments directly to --file +or --eval options. +'. + +"Parse the command-line arguments." +[Smalltalk + arguments: '-f|--file: -e|--eval: -o|--output: -h|--help --version + --no-separate-blocks' + do: [ :opt :arg | + + opt = 'help' ifTrue: [ + helpString displayOn: stdout. + ObjectMemory quit: 0 ]. + + opt = 'no-separate-blocks' ifTrue: [ + profilerClass := MethodCallGraphProfiler ]. + + opt = 'version' ifTrue: [ + ('gst-profile - %1' % {Smalltalk version}) displayNl. + ObjectMemory quit: 0 ]. + + opt = 'output' ifTrue: [ + output isNil ifFalse: [ self error: 'multiple output files' ]. + output := arg ]. + + opt = 'file' ifTrue: [ + commands add: (File name: arg) ]. + + opt = 'eval' ifTrue: [ + commands add: arg ]. + + opt isNil ifTrue: [ + last isNil + ifTrue: [ last := arg ] + ifFalse: [ SystemDictionary.SmalltalkArgv addLast: arg ] ]. + ] + + ifError: [ + helpString displayOn: stderr. + ObjectMemory quit: 1 ]. + + last isNil ifFalse: [ + commands add: (File name: last) ]. + + commands isEmpty ifTrue: [ self error: 'no commands given' ] + ] on: Error do: [ :ex | + ('gst-profile: ', ex messageText, ' +') displayOn: stderr. + stderr flush. + helpString displayOn: stderr. + ObjectMemory quit: 1 ]. + +SystemDictionary compile: + 'getpid [ <cCall: ''getpid'' returning: #int args: #()> ]'. +SystemDictionary compile: + 'arguments [ ^SmalltalkArgv asArray ]'. + +profiler := profilerClass new. +output isNil ifTrue: [ + output := Directory working / ('gst-profile.%1' % { Smalltalk getpid }) ]. + +commands do: [ :each | + "Using #readStream makes it work both for Strings and Files. + TODO: use hooks instead, maybe directly in Profiler?." + profiler withProfilerDo: [ each readStream fileIn ] ]. + +profiler printCallGraphToFile: output.
_______________________________________________ help-smalltalk mailing list [email protected] http://lists.gnu.org/mailman/listinfo/help-smalltalk
