[Scummvm-cvs-logs] SF.net SVN: scummvm: [28576] tools/branches/gsoc2007-decompiler
brixxie at users.sourceforge.net
brixxie at users.sourceforge.net
Mon Aug 13 05:32:00 CEST 2007
Revision: 28576
http://scummvm.svn.sourceforge.net/scummvm/?rev=28576&view=rev
Author: brixxie
Date: 2007-08-12 20:32:00 -0700 (Sun, 12 Aug 2007)
Log Message:
-----------
added graph-dfs egg requirement, added pseudo.scm and structuring.scm, described loop structuring algorithm in control_structures.txt
Modified Paths:
--------------
tools/branches/gsoc2007-decompiler/Makefile
tools/branches/gsoc2007-decompiler/README
tools/branches/gsoc2007-decompiler/antipasto.scm
tools/branches/gsoc2007-decompiler/cfgg.scm
tools/branches/gsoc2007-decompiler/docs/control_structures.txt
tools/branches/gsoc2007-decompiler/graph.scm
Added Paths:
-----------
tools/branches/gsoc2007-decompiler/pseudo.scm
tools/branches/gsoc2007-decompiler/structuring.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:60
+ 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:63
Modified: tools/branches/gsoc2007-decompiler/Makefile
===================================================================
--- tools/branches/gsoc2007-decompiler/Makefile 2007-08-13 02:55:19 UTC (rev 28575)
+++ tools/branches/gsoc2007-decompiler/Makefile 2007-08-13 03:32:00 UTC (rev 28576)
@@ -32,7 +32,7 @@
desword2$(EXEEXT): desword2.o util.o
$(CXX) $(LDFLAGS) -o $@ $+
-antipasto$(EXEEXT): antipasto.scm util.scm cfgg.scm graph.scm
+antipasto$(EXEEXT): antipasto.scm util.scm cfgg.scm graph.scm structuring.scm pseudo.scm
csc $< -o $@ -postlude [main]
descumm.o descumm6.o descumm-common.o descumm-tool.o: descumm.h
Modified: tools/branches/gsoc2007-decompiler/README
===================================================================
--- tools/branches/gsoc2007-decompiler/README 2007-08-13 02:55:19 UTC (rev 28575)
+++ tools/branches/gsoc2007-decompiler/README 2007-08-13 03:32:00 UTC (rev 28576)
@@ -23,7 +23,8 @@
- numbers
- vector-lib
- dyn-vector
- - digraph (use the fixed egg from eggs/)
+ - digraph
+ - graph-dfs
To obtain these execute
Modified: tools/branches/gsoc2007-decompiler/antipasto.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/antipasto.scm 2007-08-13 02:55:19 UTC (rev 28575)
+++ tools/branches/gsoc2007-decompiler/antipasto.scm 2007-08-13 03:32:00 UTC (rev 28576)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype (version 5 scripts)
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-15 05:50:37 brx>
+;;; Time-stamp: <2007-07-31 18:30:48 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
@@ -18,11 +18,13 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-(require-extension srfi-1 posix numbers digraph)
+(require-extension srfi-1 posix numbers digraph graph-dfs)
(include "util.scm")
(include "graph.scm")
(include "cfgg.scm")
+(include "structuring.scm")
+(include "pseudo.scm")
(define current-script-file #f)
(define current-script-port #f)
@@ -816,7 +818,19 @@
(let ((disassembly (decode-ops '())))
(receive (cfg intervals)
(generate-control-flow-graph disassembly)
- (print-dot cfg disassembly intervals)))
+;; (print-dot cfg disassembly intervals)
+;; (newline)
+ ;; (for-each (lambda (dgs)
+;; (let ((dg (car dgs))
+;; (ivs (cdr dgs)))
+;; (print "==")
+;; (for-each pretty-print
+;; (map (lambda (iv)
+;; (append-map (dg 'node-info) iv))
+;; ivs))))
+;; (generate-derived-graph-sequence cfg intervals))
+ (structure-loops! cfg (generate-derived-graph-sequence cfg intervals))
+ (structure-2-way! cfg)))
(close-input-port current-script-port)
(set! current-script-port #f)
(set! current-script-file #f)
Modified: tools/branches/gsoc2007-decompiler/cfgg.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/cfgg.scm 2007-08-13 02:55:19 UTC (rev 28575)
+++ tools/branches/gsoc2007-decompiler/cfgg.scm 2007-08-13 03:32:00 UTC (rev 28576)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-15 05:51:48 brx>
+;;; Time-stamp: <2007-07-31 21:19:30 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
@@ -18,14 +18,33 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;; (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")
+;; (test-run "/home/brx/code/gsoc2007-decompiler/M2.scummV5/room-15-203.dmp")
+;; (test-run "/home/brx/code/gsoc2007-decompiler/M1.scummV5/01.beach.0201")
+
+(define-record-type loop-info
+ (make-loop-info head latch type follow)
+ loop-info?
+ (head loop-head set-loop-head!)
+ (latch loop-latch set-loop-latch!)
+ (type loop-type set-loop-type!)
+ (follow loop-follow set-loop-follow!))
+
(define-record-type basic-block
- (basic-block type range)
+ (make-basic-block type range post-order loop-info follow)
basic-block?
(type bb-type set-bb-type!)
- (range bb-range set-bb-range!))
+ (range bb-range set-bb-range!)
+ (post-order post-order set-post-order!)
+ (loop-info loop-info set-loop-info!)
+ (follow bb-follow set-bb-follow!))
+(define basic-block
+ (cut make-basic-block <> <> #f (make-loop-info #f #f #f #f) #f))
+
(define-record-printer (basic-block x out)
- (fprintf out "(basic-block ~A ~A)" (bb-type x) (bb-range x)))
+ (fprintf out "(basic-block ~A ~A ~A)" (post-order x) (bb-type x) (bb-range x)))
(define (bb-update! bb #!key type range)
(when type (set-bb-type! bb type))
@@ -94,7 +113,10 @@
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 block)
+ ((g 'add-node!) i (list i block)))
+ ii
+ blocks)
(for-each (lambda (i b)
(let ((outs (match (bb-type b)
(('goto-unless jump-addr _)
@@ -115,6 +137,16 @@
blocks)
g))
+(define (inject-post-order! cfg)
+ (let ((ninfo (cfg 'node-info))
+ (po 0))
+ (define (get-po!) (set! po (add1 po)) po)
+ (for-each (lambda (npo)
+ (let ((node (second (ninfo (first npo)))))
+ (set-post-order! node (get-po!))))
+ (graph-postorder cfg 0))
+ cfg))
+
(define (generate-control-flow-graph disassembly)
(let ((cfg
(remove-isolated!
@@ -124,7 +156,8 @@
(map (lambda (instruction)
(cons (car instruction) (cddr instruction)))
disassembly)))))))
- (values cfg (generate-intervals cfg (list 0)))))
+ (values (inject-post-order! 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/docs/control_structures.txt
===================================================================
--- tools/branches/gsoc2007-decompiler/docs/control_structures.txt 2007-08-13 02:55:19 UTC (rev 28575)
+++ tools/branches/gsoc2007-decompiler/docs/control_structures.txt 2007-08-13 03:32:00 UTC (rev 28576)
@@ -127,9 +127,36 @@
D = D' = BJ1 = GP1
- Generic Set of Control Structures
- ---------------------------------
+ Graph Structuring
+ -----------------
Antipasto structures control flow graphs using the set of generic
control structures D' + goto = {1,2,3,4,5,6,7,12}.
REn, RECn, DREn and DRECn can be simulated via the use of goto.
+
+Structuring Loops:
+
+ Given an interval I(h_j) with header h_j, there is a loop rooted at
+ h_j if there is a back-edge to the header node h_j from a latching
+ node n_k \in I(h_j).
+
+ Once a loop has been found, the type of loop (e.g. pre-tested,
+ post-tested, endless) is determined according to the type of header
+ and latching nodes. Nodes belonging to the loop are flagged in order
+ to prevent nodes from belonging to two different loops as would be
+ the case in overlapping or multientry loops.
+
+ Given a control flow graph G = G1 with interval information, the
+ derived sequence of graphs G1, ..., Gn of G, and the set of intervals
+ of these Graphs, I1 ... In, an algorithm to find loops is as follows:
+ each header node of an interval in G1 is checked for having a
+ back-edge from a latching node that belongs to the same interval. If
+ so, a loop has been found, its type is determined and the nodes that
+ belong to it are marked. next the intervals of G2, I2 are checked for
+ loops and the process is repeated until intervals in In have been
+ checked. Whenever there is a potential loop that has its header or
+ latching node marked as belonging to another loop, the loop is
+ disregarded as it belongs to an unstructured loop. These loops always
+ generate goto jumps during code generation.
+ This algorithm finds the loops in the appropriate nesting level, from
+ innermost to outermost loop.
Modified: tools/branches/gsoc2007-decompiler/graph.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/graph.scm 2007-08-13 02:55:19 UTC (rev 28575)
+++ tools/branches/gsoc2007-decompiler/graph.scm 2007-08-13 03:32:00 UTC (rev 28576)
@@ -2,7 +2,7 @@
;;; Antipasto - Scumm Script Disassembler Prototype
;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-15 06:16:24 brx>
+;;; Time-stamp: <2007-07-31 21:04:36 brx>
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
@@ -22,8 +22,9 @@
(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))))
+ (let ((nodes ((g 'nodes)))
+ (edges ((g 'edges))))
+ (print "digraph G { node [shape = box, fontsize = 10, fontname = Courier]")
(for-each (lambda (n)
(match-let (((n block) n))
(print* " n"
@@ -47,43 +48,72 @@
", shape=ellipse, style=filled]")
(else "]")))))
nodes)
- (newline)
(when intervals
(for-each
(lambda (interval iter)
- (print "subgraph cluster" (car interval) " {")
- (print " label = \"I(" iter ")\"")
- (for-each
- (lambda (i)
- (print " n" 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 "}"))
- intervals
- (list-tabulate (length intervals) identity))))
- (for-each (lambda (e)
- (match-let (((i j _) e))
- (print " n" i " -> n" j)))
- ((g 'edges)))
- (print "}"))
+ (print " subgraph cluster" (car interval) " {")
+ (print " label = \"I(" iter ")\"")
+ (for-each (cut print " n" <>) interval)
+ (print " }"))
+ intervals
+ (list-tabulate (length intervals) identity)))
+ (for-each (lambda (e) (print " n" (first e) " -> n" (second e))) edges)
+ (print "}")))
(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))))
+ (let loop ((repeat? #f))
+ (for-each (lambda (root)
+ ((g 'remove-node!) root)
+ (set! repeat? #t))
+ (delete 0 ((g 'roots)) eq?))
+ (when repeat? (loop #f)))
g)
+(define (get-dominator-alist g)
+ (let ((pred (g 'pred))
+ (fen (g 'foreach-node))
+ (dalist
+ (cons (list 0 0)
+ (map (lambda (n)
+ (cons (first n)
+ (list-copy (unzip1 ((g 'nodes))))))
+ (remove (o zero? first)
+ ((g 'nodes)))))))
+ (let loop ((changed #f))
+ (for-each (lambda (da)
+ (let* ((preds (pred (car da)))
+ (pre-doms (map (o cdr (cut assq <> dalist)) preds))
+ (new-doms
+ (lset-adjoin eq?
+ (if (null? (cdr pre-doms))
+ (car pre-doms)
+ (apply lset-intersection eq? pre-doms))
+ (car da))))
+ (unless (eq? (length new-doms)
+ (length (cdr da)))
+ (set! changed #t)
+ (set-cdr! da new-doms))))
+ (cdr dalist))
+ (when changed
+ (loop #f)))
+ (map (lambda (da)
+ (cons (car da)
+ (delete (car da) (cdr da) eq?)))
+ (cdr dalist))))
+
+(define (get-immed-dominator-alist g)
+ (let ((tninfo (o second (g 'node-info))))
+ (map (lambda (da)
+ (cons (car da)
+ (fold (lambda (a z)
+ (if (> (post-order (tninfo a))
+ (post-order (tninfo z)))
+ a
+ z))
+ (cadr da)
+ (cddr da))))
+ (get-dominator-alist g))))
+
(define (find-interval nodes immed-preds interval)
(let ((new-inodes
(partition (lambda (n)
@@ -117,7 +147,6 @@
(loop (append headers new-headers)
(append (cdr unproc-headers) new-headers))))))))
-
(define (get-neighbour-intervals interval intervals neighbours selector)
(delete-duplicates
(map (lambda (n)
@@ -140,7 +169,12 @@
(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 (cute (g+1 'add-node!) <> <>)
+ ii
+ (map (lambda (iv)
+ (cons (car ((g 'node-info) (car iv)))
+ (append-map (o cdr (g 'node-info)) iv)))
+ 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)))
@@ -155,3 +189,11 @@
ii
ivs)
(values g+1 (generate-intervals g+1 (list 0)))))
+
+(define (generate-derived-graph-sequence g ivs)
+ (cons (cons g ivs)
+ (receive (g+1 ivs+1)
+ (derive-graph g ivs)
+ (if (eq? ((g+1 'order)) ((g 'order)))
+ '()
+ (generate-derived-graph-sequence g+1 ivs+1)))))
Added: tools/branches/gsoc2007-decompiler/pseudo.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/pseudo.scm (rev 0)
+++ tools/branches/gsoc2007-decompiler/pseudo.scm 2007-08-13 03:32:00 UTC (rev 28576)
@@ -0,0 +1,24 @@
+;;;; pseudo.scm
+
+;;; Antipasto - Scumm Script Disassembler Prototype
+;;; Copyright (C) 2007 Andreas Scholta
+;;; Time-stamp: <2007-07-31 14:39:25 brx>
+
+;;; This program 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
+;;; of the License, or (at your option) any later version.
+
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+(define (pseudo-out out cfg disassembly)
+ (define (output ind str . args)
+ (apply printf (string-append (make-string ind) str) args))
+ #f)
Property changes on: tools/branches/gsoc2007-decompiler/pseudo.scm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: tools/branches/gsoc2007-decompiler/structuring.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/structuring.scm (rev 0)
+++ tools/branches/gsoc2007-decompiler/structuring.scm 2007-08-13 03:32:00 UTC (rev 28576)
@@ -0,0 +1,177 @@
+;;;; structuring.scm
+
+;;; Antipasto - Scumm Script Disassembler Prototype
+;;; Copyright (C) 2007 Andreas Scholta
+;;; Time-stamp: <2007-07-31 21:21:37 brx>
+
+;;; This program 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
+;;; of the License, or (at your option) any later version.
+
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+(define (po->nn g node)
+ (let ((po (post-order node))
+ (ns ((g 'nodes))))
+ (first (find (lambda (n)
+ (= po (post-order (second (second n)))))
+ ns))))
+
+;;; Loop Structuring
+
+(define (maybe-get-latching g header ivn)
+ (let ((ninfo (g 'node-info)))
+ (let find-latching ((ins (unzip1 ((g 'in-edges) header))))
+ (cond ((null? ins) #f)
+ ((memq (second (ninfo (car ins))) ivn) (second (ninfo (car ins))))
+ (else (find-latching (cdr ins)))))))
+
+(define (mark-nodes! latching header ivn)
+ (let ((header-po (post-order header))
+ (latching-po (post-order latching)))
+ (let mark ((ivn ivn)
+ (loop-nodes '()))
+ (if (null? ivn)
+ loop-nodes
+ (let* ((node (car ivn))
+ (linfo (loop-info node)))
+ (if (<= header-po (post-order node) latching-po)
+ (begin
+ (when (not (loop-head linfo))
+ (set-loop-head! linfo header)
+ (set-loop-latch! linfo latching))
+ (mark (cdr ivn) (cons node loop-nodes)))
+ (mark (cdr ivn) loop-nodes)))))))
+
+(define (choose-loop-type! latching header hnum nodes-in-loop g)
+ (let ((oedges (g 'out-edges))
+ (ninfo (g 'node-info)))
+ (set-loop-type! (loop-info header)
+ (match (cons (bb-type latching) (bb-type header))
+ ((('goto-unless . _) . ('goto-unless . _))
+ (let ((oe (map second (oedges hnum))))
+ (if (and (memq (second (ninfo (first oe))) nodes-in-loop)
+ (memq (second (ninfo (second oe))) nodes-in-loop))
+ 'post-tested
+ 'pre-tested)))
+ ((('goto-unless . _) . (or ('goto . _) 'fall 'return))
+ 'post-tested)
+ (((or ('goto . _ ) 'fall 'return) . ('goto-unless . _))
+ 'pre-tested)
+ (((or ('goto . _) 'fall 'return) . (or ('goto . _) 'fall 'return))
+ 'endless)))))
+
+(define (choose-loop-follow! latching lnum header hnum nodes-in-loop g)
+ (let ((oedges (g 'out-edges))
+ (ninfo (g 'node-info)))
+ (set-loop-follow! (loop-info header)
+ (case (loop-type (loop-info header))
+ ((pre-tested)
+ (let ((oe (map second (oedges hnum))))
+ (if (memq (second (ninfo (first oe))) nodes-in-loop)
+ (second (ninfo (second oe)))
+ (second (ninfo (first oe))))))
+ ((post-tested)
+ (let ((oe (map second (oedges lnum))))
+ (if (memq (second (ninfo (first oe))) nodes-in-loop)
+ (second (ninfo (second oe)))
+ (second (ninfo (first oe))))))
+ (else
+ (let ((fol (expt 2 32))
+ (cn #f))
+ (for-each (lambda (twn)
+ (let ((oe (map second (oedges (po->nn g twn)))))
+ (cond
+ ((and (not (memq (second (ninfo (first oe)))
+ nodes-in-loop))
+ (< (post-order (second (ninfo (first oe)))) fol))
+ (set! cn (second (ninfo (second oe))))
+ (set! fol (post-order (second (ninfo (first oe))))))
+ ((and (not (memq (second (ninfo (second oe)))
+ nodes-in-loop))
+ (< (post-order (second (ninfo (second oe)))) fol))
+ (set! cn (second (ninfo (second oe))))
+ (set! fol (post-order (second (ninfo (second oe)))))))))
+ (filter (lambda (node)
+ (match (bb-type node)
+ (('goto-unless . _) #t)
+ (else #f)))
+ nodes-in-loop))
+ cn))))))
+
+(define (structure-loops! top-graph dgs)
+ (if (null? dgs)
+ (void)
+ (match-let ((((g . ivs) . rest) dgs))
+ (for-each (lambda (iv)
+ (let* ((iv-nodes (append-map (o cdr (g 'node-info)) iv))
+ (header (car iv-nodes))
+ (hnum (car ((g 'node-info) (car iv))))
+ (latching (maybe-get-latching top-graph hnum iv-nodes)))
+ (when latching
+ (let ((nodes-in-loop (mark-nodes! latching header iv-nodes)))
+ (choose-loop-type! latching
+ header
+ hnum
+ nodes-in-loop
+ top-graph)
+ (choose-loop-follow! latching
+ (po->nn top-graph latching)
+ header
+ hnum
+ nodes-in-loop
+ top-graph)))))
+ ivs)
+ (structure-loops! top-graph rest))))
+
+;;; Conditionals Structuring
+
+(define (head-or-latch? node)
+ (let ((linfo (loop-info node)))
+ (or (eq? (loop-head linfo) node)
+ (eq? (loop-latch linfo) node))))
+
+(define (structure-2-way! top-graph)
+ (let ((ninfo (o second (top-graph 'node-info)))
+ (idoms (get-immed-dominator-alist top-graph)))
+ (let loop ((nodes (unzip1
+ (sort (graph-postorder top-graph 0)
+ (lambda (a b)
+ (< (second a) (second b))))))
+ (unresolved '()))
+ (if (null? nodes)
+ (void)
+ (let ((node (car nodes)))
+ (if (not (head-or-latch? (ninfo node)))
+ (let ((ns (unzip1 (partition (lambda (idom)
+ (eq? node (cdr idom)))
+ idoms))))
+ (if (null? ns)
+ (loop (cdr nodes)
+ (cons node unresolved))
+ (let ((m (car
+ (sort ns
+ (lambda (a b)
+ (> (post-order (ninfo a))
+ (post-order (ninfo b))))))))
+ (for-each (lambda (ur)
+ (set-bb-follow! (ninfo ur)
+ (ninfo m)))
+ unresolved)
+ (set-bb-follow! (ninfo node)
+ (ninfo m))
+ (loop (cdr nodes) '()))))
+ (loop (cdr nodes) unresolved)))))))
+
+;; (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")
+;; (test-run "/home/brx/code/gsoc2007-decompiler/M2.scummV5/room-15-203.dmp")
+;; (test-run "/home/brx/code/gsoc2007-decompiler/M1.scummV5/01.beach.0201")
Property changes on: tools/branches/gsoc2007-decompiler/structuring.scm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
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