[Help-smalltalk] [PATCH] gst-profile

[Paolo Bonzini]

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 <address@hidden>
Date:   Mon Feb 23 09:55:26 2009 +0100

    add gst-profile.
    
    2009-02-22  Paolo Bonzini  <address@hidden>
    
        * 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  <address@hidden>
+
+       * scripts/Profile.st: New.
+       * gst-tool.c: Add its options.
+
 2009-02-19  Paolo Bonzini  <address@hidden>
 
        * 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.