[Scummvm-cvs-logs] SF.net SVN: scummvm: [28088] tools/branches/gsoc2007-decompiler
brixxie at users.sourceforge.net
brixxie at users.sourceforge.net
Sun Jul 15 05:36:38 CEST 2007
Revision: 28088
http://scummvm.svn.sourceforge.net/scummvm/?rev=28088&view=rev
Author: brixxie
Date: 2007-07-14 20:36:37 -0700 (Sat, 14 Jul 2007)
Log Message:
-----------
added generation of graph descriptions in graphviz format for neat visuals
Modified Paths:
--------------
tools/branches/gsoc2007-decompiler/antipasto.scm
tools/branches/gsoc2007-decompiler/cfgg.scm
tools/branches/gsoc2007-decompiler/graph.scm
Property Changed:
----------------
tools/branches/gsoc2007-decompiler/
Property changes on: tools/branches/gsoc2007-decompiler
___________________________________________________________________
Name: svk:merge
- 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:47
+ 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:49
Modified: tools/branches/gsoc2007-decompiler/antipasto.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/antipasto.scm 2007-07-15 03:33:19 UTC (rev 28087)
+++ tools/branches/gsoc2007-decompiler/antipasto.scm 2007-07-15 03:36:37 UTC (rev 28088)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype (version 5 scripts)
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-14 19:09:42 brx>
+;;; Time-stamp: <2007-07-15 05:30:44 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
@@ -813,25 +813,10 @@
(set! current-script-port (open-input-file current-script-file))
(set! current-script-offset 0)
(parse-header)
- (let ((decoded (decode-ops '())))
- (let print-decoded ((decoded decoded))
- (unless (or (null? decoded)
- (not decoded)
- (not (car decoded)))
- (printf "[~A] (~X) "
- (caar decoded)
- (cadar decoded))
- (pretty-print (cddar decoded))
- (print-decoded (cdr decoded))))
- (receive (basic-blocks intervals)
- (generate-control-flow-graph decoded)
- (printf "Basic Blocks:\n")
- (pretty-print basic-blocks)
- (newline)
- (printf "Intervals:\n")
- (for-each (compose (hole newline)
- (cut pretty-print <>))
- intervals)))
+ (let ((disassembly (decode-ops '())))
+ (receive (cfg intervals)
+ (generate-control-flow-graph disassembly)
+ (print-dot cfg disassembly intervals)))
(close-input-port current-script-port)
(set! current-script-port #f)
(set! current-script-file #f)
@@ -845,5 +830,5 @@
(define (main)
(if (= (length (argv)) 2)
(test-run (cadr (argv)))
- (printf "Usage: ~A <scummV5 script>~%"
- (car (argv)))))
+ (let ((script-file (car (argv))))
+ (printf "Usage: ~A <scummV5 script>~%" script-file))))
Modified: tools/branches/gsoc2007-decompiler/cfgg.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/cfgg.scm 2007-07-15 03:33:19 UTC (rev 28087)
+++ tools/branches/gsoc2007-decompiler/cfgg.scm 2007-07-15 03:36:37 UTC (rev 28088)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-14 19:15:00 brx>
+;;; Time-stamp: <2007-07-15 05:25:28 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
@@ -125,8 +125,7 @@
(map (lambda (instruction)
(cons (car instruction) (cddr instruction)))
disassembly)))))))
- (values ((cfg 'nodes))
- (generate-intervals cfg (list 0)))))
+ (values cfg (generate-intervals cfg (list 0)))))
;; (test-run "/home/brx/code/gsoc2007-decompiler/M1.scummV5/81.cu_bar_2.0092")
;; (test-run "/home/brx/code/gsoc2007-decompiler/M2.scummV5/entry-4.dmp")
Modified: tools/branches/gsoc2007-decompiler/graph.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/graph.scm 2007-07-15 03:33:19 UTC (rev 28087)
+++ tools/branches/gsoc2007-decompiler/graph.scm 2007-07-15 03:36:37 UTC (rev 28088)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-14 18:02:02 brx>
+;;; Time-stamp: <2007-07-15 05:27:08 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
@@ -18,6 +18,61 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;; ugly graphviz output stuff
+(define (print-dot g disassembly intervals)
+ (define (quote-string str)
+ (string-translate* str '(("\"" . "\\\""))))
+ (print "digraph G { node [shape = box, fontsize = 10, fontname = Courier]")
+ (let ((nodes ((g 'nodes))))
+ (for-each (lambda (n)
+ (match-let (((n block) n))
+ (print* " n"
+ n
+ " [label = \""
+ (quote-string (format "~S"
+ (cdr (assq (car (bb-range block))
+ disassembly)))))
+ (for-each
+ (lambda (in)
+ (print* "\\l"
+ (quote-string (format "~S" (cdr (assq in disassembly))))))
+ (cdr (bb-range block)))
+ (print "\""
+ (cond ((zero? (car (bb-range block)))
+ ", shape=ellipse, style=bold]")
+ ((eq? 'return (bb-type block))
+ ", shape=ellipse, style=filled]")
+ (else "]")))))
+ nodes)
+ (newline)
+ (if intervals
+ (for-each
+ (lambda (interval iter)
+ (let ((extern '()))
+ (print "subgraph cluster" (car interval) " {")
+ (print " label = \"I(" iter ")\"")
+ (for-each
+ (lambda (i)
+ (receive (intern ext)
+ (partition (cut member <> interval)
+ (map second ((g 'out-edges) i)))
+ (for-each (lambda (ij)
+ (print " n" i " -> n" ij))
+ intern)
+ (set! extern (append extern (map (cut cons i <>) ext)))))
+ interval)
+ (print "}")
+ (for-each (lambda (e)
+ (print " n" (car e) " -> n" (cdr e)))
+ extern)))
+ intervals
+ (list-tabulate (length intervals) identity))
+ (for-each (lambda (e)
+ (match-let (((i j _) e))
+ (print " n" i " -> n" j)))
+ ((g 'edges)))))
+ (print "}"))
+
(define (remove-isolated! g)
(let loop ()
(let ((repeat? #f))
@@ -65,10 +120,12 @@
(define (get-neighbour-intervals interval intervals neighbours selector)
(delete-duplicates
(map (lambda (n)
- (let ((ind (list-index (cut member n <>) intervals)))
- ;; assert that n IS part of an interval ...
- (assert ind)
- ind))
+ ;; note that for outgoing neighbours should always be
+ ;; interval headers (or else their containing subgraph
+ ;; would not be single-entry, aka an interval)
+ (let ((index (list-index (cut member n <>) intervals)))
+ ;; assert that N is member of an interval ...
+ (assert index) index))
(lset-difference eq?
(delete-duplicates
(append-map (o (cut map selector <>) neighbours)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the Scummvm-git-logs
mailing list