[Scummvm-cvs-logs] SF.net SVN: scummvm: [27982] tools/branches/gsoc2007-decompiler

brixxie at users.sourceforge.net brixxie at users.sourceforge.net
Mon Jul 9 01:38:34 CEST 2007


Revision: 27982
          http://scummvm.svn.sourceforge.net/scummvm/?rev=27982&view=rev
Author:   brixxie
Date:     2007-07-08 16:38:33 -0700 (Sun, 08 Jul 2007)

Log Message:
-----------
Added (fixed) Basic Block generation code

Modified Paths:
--------------
    tools/branches/gsoc2007-decompiler/Makefile
    tools/branches/gsoc2007-decompiler/antipasto.scm
    tools/branches/gsoc2007-decompiler/cfgg.scm
    tools/branches/gsoc2007-decompiler/util.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:38
   + 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:39

Modified: tools/branches/gsoc2007-decompiler/Makefile
===================================================================
--- tools/branches/gsoc2007-decompiler/Makefile	2007-07-08 23:38:03 UTC (rev 27981)
+++ tools/branches/gsoc2007-decompiler/Makefile	2007-07-08 23:38:33 UTC (rev 27982)
@@ -32,7 +32,7 @@
 desword2$(EXEEXT): desword2.o util.o
 	$(CXX) $(LDFLAGS) -o $@ $+
 
-antipasto$(EXEEXT): antipasto.scm util.scm
+antipasto$(EXEEXT): antipasto.scm util.scm cfgg.scm
 	csc $< -o $@ -postlude [main]
 
 descumm.o descumm6.o descumm-common.o descumm-tool.o: descumm.h

Modified: tools/branches/gsoc2007-decompiler/antipasto.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/antipasto.scm	2007-07-08 23:38:03 UTC (rev 27981)
+++ tools/branches/gsoc2007-decompiler/antipasto.scm	2007-07-08 23:38:33 UTC (rev 27982)
@@ -2,7 +2,7 @@
 
 ;;; Antipasto - Scumm Script Disassembler Prototype (version 5 scripts)
 ;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-07 01:11:26 brx>
+;;; Time-stamp: <2007-07-08 20:34:50 brx>
 
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License
@@ -21,6 +21,7 @@
 (require-extension posix numbers srfi-1)
 
 (include "util.scm")
+(include "cfgg.scm")
 
 (define current-script-file #f)
 (define current-script-port #f)
@@ -689,8 +690,7 @@
 (register-123-op 'band! #x17 handle-sarith 1)
 
 (define (calc-abs-jump relative)
-  (sprintf "~X" ;only for testing purposes with intermediary format
-           (band #x7fff (+ relative current-script-offset))))
+  (band #x7fff (+ relative current-script-offset)))
 
 (register-opcode 'goto
                  #x18
@@ -812,16 +812,19 @@
   (set! current-script-port (open-input-file current-script-file))
   (set! current-script-offset 0)
   (parse-header)
-  (let print-decoded ((decoded (decode-ops '())))
-    (unless (or (null? decoded)
-                (not decoded)
-                (not (car decoded)))
-      (printf "[~X] (~X) "
-              (caar decoded)
-              (cadar decoded))
-      (write (cddar decoded))
-      (newline)
-      (print-decoded (cdr decoded))))
+  (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))
+        (write (cddar decoded))
+        (newline)
+        (print-decoded (cdr decoded))))
+    (for-each (cut printf "~S\n" <>)
+              (generate-control-flow-graph decoded)))
   (close-input-port current-script-port)
   (set! current-script-port #f)
   (set! current-script-file #f)
@@ -829,7 +832,7 @@
 
 ;; (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/M2.scummV5/room-15-203.dmp")
 ;; (test-run "/home/brx/code/gsoc2007-decompiler/M1.scummV5/01.beach.0201")
 
 (define (main)

Modified: tools/branches/gsoc2007-decompiler/cfgg.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/cfgg.scm	2007-07-08 23:38:03 UTC (rev 27981)
+++ tools/branches/gsoc2007-decompiler/cfgg.scm	2007-07-08 23:38:33 UTC (rev 27982)
@@ -2,7 +2,7 @@
 
 ;;; Antipasto - Scumm Script Disassembler Prototype
 ;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-07 20:06:40 brx>
+;;; Time-stamp: <2007-07-09 01:31:43 brx>
 
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License
@@ -17,3 +17,139 @@
 ;;; 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-record basic-block type range preds succs)
+
+(define-record-printer (basic-block x out)
+  (fprintf out
+           "#,(basic-block ~S ~S ~S ~S)"
+           (basic-block-type x)
+           (basic-block-range x)
+           (map basic-block-range (basic-block-preds x))
+           (map basic-block-range (basic-block-succs x))))
+
+(define (create-basic-block type range)
+  (make-basic-block type range '() '()))
+
+(define (basic-block-type-smart block)
+  (let ((type (basic-block-type block)))
+    (if (pair? type)
+        (car type)
+        type)))
+
+(define (update-basic-block! block #!key type range preds succs)
+  (when type (basic-block-type-set! block type))
+  (when range (basic-block-range-set! block range))
+  (when preds (basic-block-preds-set! block preds))
+  (when succs (basic-block-succs-set! block succs))
+  block)
+
+(define (basic-block-connect! pred succ)
+  (basic-block-succs-set! pred (cons succ (basic-block-succs pred)))
+  (basic-block-preds-set! succ (cons pred (basic-block-preds succ)))
+  succ)
+
+(define (remove-opcodes-from-disassembly disassembly)
+  (map (lambda (instruction)
+         (cons (car instruction)
+               (cddr instruction)))
+       disassembly))
+
+(define (get-trivial-block instructions)
+  (let get-trivial ((addrs '())
+                    (instrs instructions))
+    (if (null? instrs)
+        (values (create-basic-block 'return
+                                    (reverse addrs))
+                '())
+        (let ((instr (car instrs)))
+          (case (cadr instr)
+            ((goto goto-unless)
+             (values (create-basic-block (cdr instr)
+                                         (reverse (cons (car instr)
+                                                        addrs)))
+                     (cdr instrs)))
+            (else
+             (get-trivial (cons (car instr) addrs)
+                          (cdr instrs))))))))
+
+(define (generate-trivial-blocks disassembly blocks connect?)
+  (if (null? disassembly)
+      (reverse blocks)
+      (receive (trivial-block rest)
+          (get-trivial-block disassembly)
+        (when connect? (basic-block-connect! (car blocks) trivial-block))
+        (generate-trivial-blocks
+         rest
+         (cons trivial-block blocks)
+         (not
+          (eq? 'goto
+               (basic-block-type-smart trivial-block)))))))
+
+(define (rewire-preds! block new-succ)
+  (for-each (lambda (pred)
+              (basic-block-succs-set!
+               pred
+               (cons new-succ
+                     (delete block (basic-block-succs pred) eq?))))
+            (basic-block-preds block)))
+
+(define (splice-block! block pivot pred)
+  (receive (fall-range rest-range)
+      (partition (cut < <> pivot)
+                 (basic-block-range block))
+    (let ((fall-block (make-basic-block 'fall fall-range
+                                        (basic-block-preds block)
+                                        (list block))))
+      (rewire-preds! block fall-block)
+      (values
+       fall-block
+       (basic-block-connect! pred
+                             (update-basic-block! block
+                                                  range: rest-range
+                                                  preds: (list fall-block)))))))
+
+(define (find/splice-block! block jump-addr fblocks)
+  (if (null? fblocks)
+      '()
+      (let* ((fblock (car fblocks))
+             (fblock-range (basic-block-range fblock)))
+        (cond ((eq? (car fblock-range) jump-addr)
+               (cons (basic-block-connect! block fblock)
+                     (cdr fblocks)))
+              ((memq jump-addr fblock-range)
+               (call-with-values
+                   (lambda ()
+                     (splice-block! fblock jump-addr block))
+                 (cut cons* <> <> (cdr fblocks))))
+              (else
+               (cons fblock
+                     (find/splice-block! block
+                                         jump-addr
+                                         (cdr fblocks))))))))
+
+(define (correct-trivial-blocks! trivial-blocks fixed-blocks)
+  (if (null? trivial-blocks)
+      fixed-blocks
+      (let* ((block (car trivial-blocks))
+             (type (basic-block-type block))
+             (smart-type (basic-block-type-smart block)))
+        (if (or (eq? 'goto-unless smart-type)
+                (eq? 'goto smart-type))
+            (correct-trivial-blocks! (cdr trivial-blocks)
+                                     (find/splice-block! block
+                                                         (cadr type)
+                                                         fixed-blocks))
+            (correct-trivial-blocks! (cdr trivial-blocks)
+                                     fixed-blocks)))))
+
+(define (generate-control-flow-graph disassembly)
+  (let ((trivial-blocks
+         (generate-trivial-blocks
+          (remove-opcodes-from-disassembly disassembly) '() #f)))
+    (correct-trivial-blocks! trivial-blocks trivial-blocks)))
+
+;; (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")

Modified: tools/branches/gsoc2007-decompiler/util.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/util.scm	2007-07-08 23:38:03 UTC (rev 27981)
+++ tools/branches/gsoc2007-decompiler/util.scm	2007-07-08 23:38:33 UTC (rev 27982)
@@ -2,7 +2,7 @@
 
 ;;; Antipasto - Scumm Script Disassembler Prototype
 ;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-07-07 01:11:13 brx>
+;;; Time-stamp: <2007-07-08 20:45:42 brx>
 
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License


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