[Scummvm-cvs-logs] SF.net SVN: scummvm: [28079] tools/branches/gsoc2007-decompiler
brixxie at users.sourceforge.net
brixxie at users.sourceforge.net
Sat Jul 14 22:36:26 CEST 2007
Revision: 28079
http://scummvm.svn.sourceforge.net/scummvm/?rev=28079&view=rev
Author: brixxie
Date: 2007-07-14 13:36:26 -0700 (Sat, 14 Jul 2007)
Log Message:
-----------
Added derived graph sequencing algorithm, added fixed digraph egg,
updated README
changed properties..
Modified Paths:
--------------
tools/branches/gsoc2007-decompiler/README
tools/branches/gsoc2007-decompiler/antipasto.scm
tools/branches/gsoc2007-decompiler/cfgg.scm
tools/branches/gsoc2007-decompiler/graph.scm
Added Paths:
-----------
tools/branches/gsoc2007-decompiler/eggs/
tools/branches/gsoc2007-decompiler/eggs/digraph-fix.patch
tools/branches/gsoc2007-decompiler/eggs/digraph.egg
Property Changed:
----------------
tools/branches/gsoc2007-decompiler/
Property changes on: tools/branches/gsoc2007-decompiler
___________________________________________________________________
Name: svk:merge
- 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:43
+ 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:47
Modified: tools/branches/gsoc2007-decompiler/README
===================================================================
--- tools/branches/gsoc2007-decompiler/README 2007-07-14 18:26:43 UTC (rev 28078)
+++ tools/branches/gsoc2007-decompiler/README 2007-07-14 20:36:26 UTC (rev 28079)
@@ -17,18 +17,19 @@
Build procedure:
-Two CHICKEN libraries ("eggs") are needed to compile Antipasto:
+These CHICKEN libraries ("eggs") are needed to compile Antipasto:
- - syntax-case.egg
- - numbers.egg
- - digraph.egg
- (has own dependencies which should be resolved by
- chicken-setup automatically)
+ - syntax-case
+ - numbers
+ - vector-lib
+ - dyn-vector
+ - digraph (use the fixed egg from eggs/)
To obtain these execute
$ chicken-setup syntax-case
$ chicken-setup numbers
+ ...
in your favorite shell. Afterwards a simple
Modified: tools/branches/gsoc2007-decompiler/antipasto.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/antipasto.scm 2007-07-14 18:26:43 UTC (rev 28078)
+++ tools/branches/gsoc2007-decompiler/antipasto.scm 2007-07-14 20:36:26 UTC (rev 28079)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype (version 5 scripts)
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-13 22:16:52 brx>
+;;; Time-stamp: <2007-07-14 19:09:42 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
Modified: tools/branches/gsoc2007-decompiler/cfgg.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/cfgg.scm 2007-07-14 18:26:43 UTC (rev 28078)
+++ tools/branches/gsoc2007-decompiler/cfgg.scm 2007-07-14 20:36:26 UTC (rev 28079)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-14 02:17:58 brx>
+;;; Time-stamp: <2007-07-14 19:15:00 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
@@ -25,7 +25,7 @@
(range bb-range set-bb-range!))
(define-record-printer (basic-block x out)
- (fprintf out "#,(basic-block ~S ~S)" (bb-type x) (bb-range x)))
+ (fprintf out "(basic-block ~A ~A)" (bb-type x) (bb-range x)))
(define (bb-update! bb #!key type range)
(when type (set-bb-type! bb type))
@@ -94,11 +94,8 @@
blocks))
(let ((g (make-digraph 'cfg "control flow graph"))
(ii (list-tabulate (length blocks) identity)))
+ (for-each (cut (g 'add-node!) <> <>) ii blocks)
(for-each (lambda (i b)
- ((g 'add-node!) i b))
- ii
- blocks)
- (for-each (lambda (i b)
(let ((outs (match (bb-type b)
(('goto-unless jump-addr _)
(list (add1 i)
@@ -110,24 +107,24 @@
(else
#f))))
(when outs
- (for-each (g 'add-edge!)
- (map (lambda (out)
- (list i
- out
- (cons b (list-ref blocks out))))
- outs)))))
+ (for-each (lambda (out)
+ (unless ((g 'has-edge) i out)
+ ((g 'add-edge!)
+ (list i out #f))))
+ outs))))
ii
blocks)
g))
(define (generate-control-flow-graph disassembly)
(let ((cfg
- (blocks->cfg
- (correct-blocks!
- (generate-trivial-blocks
- (map (lambda (instruction)
- (cons (car instruction) (cddr instruction)))
- disassembly))))))
+ (remove-isolated!
+ (blocks->cfg
+ (correct-blocks!
+ (generate-trivial-blocks
+ (map (lambda (instruction)
+ (cons (car instruction) (cddr instruction)))
+ disassembly)))))))
(values ((cfg 'nodes))
(generate-intervals cfg (list 0)))))
Added: tools/branches/gsoc2007-decompiler/eggs/digraph-fix.patch
===================================================================
--- tools/branches/gsoc2007-decompiler/eggs/digraph-fix.patch (rev 0)
+++ tools/branches/gsoc2007-decompiler/eggs/digraph-fix.patch 2007-07-14 20:36:26 UTC (rev 28079)
@@ -0,0 +1,59 @@
+--- digraph.scm 2007-05-30 05:12:18.000000000 +0200
++++ digraph-fixed.scm 2007-07-14 17:48:36.296839726 +0200
+@@ -108,13 +108,13 @@
+ (define (remove-pred elst j ax)
+ (match elst
+ (() (dynvector-set! pred j ax))
+- (((i1 . _) . es) (let ((e (car elst)))
+- (remove-pred es j (if (fx= i1 i) es (cons e es)))))
++ (((i1 _ _) . es) (let ((e (car elst)))
++ (remove-pred es j (if (fx= i1 i) ax (cons e ax)))))
+ (else (digraph:error 'remove-pred ": invalid edge list " elst))))
+
+ (define (remove-edge e)
+ (match e
+- ((i1 j . _) (begin
++ ((i1 j _) (begin
+ (if (not (fx= i i1)) (digraph:error 'set-out-edges))
+ (remove-pred (dynvector-ref pred j) j (list))))
+ (else (digraph:error 'remove-edge ": invalid edge " e))))
+@@ -134,16 +134,16 @@
+ (define (set-in-edges! j edges)
+ (define (remove-succ elst i ax)
+ (match elst
+- (() (dynvector-set! pred j ax))
++ (() (dynvector-set! succ i ax))
+ (((_ j1 _) . es) (let ((e (car elst)))
+- (remove-succ es i (if (fx= j1 j) es (cons e es)))))
++ (remove-succ es i (if (fx= j1 j) ax (cons e ax)))))
+ (else (digraph:error 'remove-succ ": invalid edge list " elst))))
+
+ (define (remove-edge e)
+ (match e
+- ((i j1 . _) (begin
++ ((i j1 _) (begin
+ (if (not (fx= j j1)) (digraph:error 'set-in-edges))
+- (remove-succ (dynvector-ref pred i) i (list))))
++ (remove-succ (dynvector-ref succ i) i (list))))
+ (else (digraph:error 'remove-edge ": invalid edge " e))))
+
+ (define (add-succ e)
+@@ -230,11 +230,16 @@
+ ((foreach-node) foreach-node)
+ ((foreach-edge) foreach-edge)
+ ((roots) (lambda ()
+- (filter-map (lambda (n) (if (null? (in-edges (car n))) (car n) #f))
++ (filter-map (lambda (n)
++ (if (null?
++ ;; check only edges from other nodes
++ (remove (o (cut fx= <> (car n)) car)
++ (in-edges (car n))))
++ (car n)
++ #f))
+ (get-nodes))))
+ ((debug) (list (cons nodes (dynvector->list nodes))
+ (cons succ (dynvector->list succ))
+ (cons pred (dynvector->list pred))))
+ (else
+ (digraph:error 'selector ": unknown message " selector " sent to a graph"))))))
+-
Property changes on: tools/branches/gsoc2007-decompiler/eggs/digraph-fix.patch
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: tools/branches/gsoc2007-decompiler/eggs/digraph.egg
===================================================================
(Binary files differ)
Property changes on: tools/branches/gsoc2007-decompiler/eggs/digraph.egg
___________________________________________________________________
Name: svn:mime-type
+ application/x-gzip
Modified: tools/branches/gsoc2007-decompiler/graph.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/graph.scm 2007-07-14 18:26:43 UTC (rev 28078)
+++ tools/branches/gsoc2007-decompiler/graph.scm 2007-07-14 20:36:26 UTC (rev 28079)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-14 02:21:16 brx>
+;;; Time-stamp: <2007-07-14 18:02:02 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,16 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+(define (remove-isolated! g)
+ (let loop ()
+ (let ((repeat? #f))
+ (for-each (lambda (root)
+ ((g 'remove-node!) root)
+ (set! repeat? #t))
+ (delete 0 ((g 'roots)) eq?))
+ (when repeat? (loop))))
+ g)
+
(define (find-interval nodes immed-preds interval)
(let ((new-inodes
(partition (lambda (n)
@@ -32,21 +42,58 @@
(find-interval nodes immed-preds (append interval new-inodes)))))
(define (generate-intervals g headers)
- (let loop ((headers headers)
- (unproc-headers headers))
- (if (null? unproc-headers)
- '()
- (let* ((nodes (unzip1 ((g 'nodes))))
- (immed-preds (o unzip1 (g 'in-edges)))
- (new-interval
- (find-interval nodes immed-preds (list (car unproc-headers))))
- (new-headers
- (partition (lambda (n)
- (and (not (memq n headers))
- (not (memq n new-interval))
- (any (cut memq <> new-interval)
- (immed-preds n))))
- nodes)))
- (cons new-interval
- (loop (append headers new-headers)
- (append (cdr unproc-headers) new-headers)))))))
+ (let ((nodes (unzip1 ((g 'nodes))))
+ (immed-preds (o unzip1 (g 'in-edges))))
+ (let loop ((headers headers)
+ (unproc-headers headers))
+ (if (null? unproc-headers)
+ '()
+ (let* ((new-interval
+ (find-interval nodes immed-preds (list (car unproc-headers))))
+ (new-headers
+ (partition (lambda (n)
+ (and (not (memq n headers))
+ (not (memq n new-interval))
+ (any (cut memq <> new-interval)
+ (immed-preds n))))
+ nodes)))
+ (cons new-interval
+ (loop (append headers new-headers)
+ (append (cdr unproc-headers) new-headers))))))))
+
+
+(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))
+ (lset-difference eq?
+ (delete-duplicates
+ (append-map (o (cut map selector <>) neighbours)
+ interval)
+ eq?)
+ interval))
+ eq?))
+
+(define (derive-graph g ivs)
+ (define get-neigh-ivs
+ (cut get-neighbour-intervals <> ivs <> <>))
+ (let* ((g+1 (make-digraph 'derived-graph (cons g ivs)))
+ (ii (list-tabulate (length ivs) identity)))
+ (for-each (cut (g+1 'add-node!) <> <>) ii ivs)
+ (for-each (lambda (i iv)
+ (let ((sipreds (get-neigh-ivs iv (g 'in-edges) first))
+ (sisuccs (get-neigh-ivs iv (g 'out-edges) second)))
+ (for-each (lambda (j)
+ (unless ((g+1 'has-edge) j i)
+ ((g+1 'add-edge!) (list j i #f))))
+ sipreds)
+ (for-each (lambda (j)
+ (unless ((g+1 'has-edge) i j)
+ ((g+1 'add-edge!) (list i j #f))))
+ sisuccs)))
+ ii
+ ivs)
+ (values g+1 (generate-intervals g+1 (list 0)))))
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