guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-1-60-g6cf


From: Michael Gran
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-1-60-g6cf4830
Date: Wed, 12 Aug 2009 07:59:46 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6cf48307989d2552f2215ef8406ea92745d2d3e9

The branch, master has been updated
       via  6cf48307989d2552f2215ef8406ea92745d2d3e9 (commit)
      from  744c8724a7060abb7ad749f4db7eadb342184572 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6cf48307989d2552f2215ef8406ea92745d2d3e9
Author: Michael Gran <address@hidden>
Date:   Wed Aug 12 00:26:12 2009 -0700

    Fix disassembly of strings and symbols
    
    * module/language/assembly/decompile-bytecode.scm (decode-bytecode):
      fix disassembly of strings, symbols, keywords, and defines

-----------------------------------------------------------------------

Summary of changes:
 module/language/assembly/decompile-bytecode.scm |   24 +++++++++++++++++++++-
 1 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/module/language/assembly/decompile-bytecode.scm 
b/module/language/assembly/decompile-bytecode.scm
index 0e34ab4..a05db53 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -24,6 +24,7 @@
   #:use-module (srfi srfi-4)
   #:use-module (rnrs bytevector)
   #:use-module (language assembly)
+  #:use-module ((system vm objcode) #:select (byte-order))
   #:export (decompile-bytecode))
 
 (define (decompile-bytecode x env opts)
@@ -95,13 +96,26 @@
                   (lp (cons exp out))))))))))
 
 (define (decode-bytecode pop)
+  (define (get1 bytes-per-char)
+    (if (= bytes-per-char 1)
+        (pop)
+        (let* ((a (pop))
+               (b (pop))
+               (c (pop))
+               (d (pop)))
+          (if (= byte-order 1234)
+              (+ (ash d 24) (ash c 16) (ash b 8) a)            
+              (+ (ash a 24) (ash b 16) (ash c 8) d)))))
   (and=> (pop)
          (lambda (opcode)
            (let ((inst (opcode->instruction opcode)))
              (cond
               ((eq? inst 'load-program)
                (decode-load-program pop))
+
               ((< (instruction-length inst) 0)
+               ;; the negative length indicates a variable length
+               ;; instruction
                (let* ((make-sequence
                        (if (eq? inst 'load-array)
                            make-bytevector
@@ -111,15 +125,21 @@
                            bytevector-u8-set!
                            (lambda (str pos value)
                              (string-set! str pos (integer->char value)))))
-
                       (len (let* ((a (pop)) (b (pop)) (c (pop)))
                              (+ (ash a 16) (ash b 8) c)))
+                      (bytes-per-count
+                       (if (or (eq? inst 'load-string)
+                               (eq? inst 'load-symbol)
+                               (eq? inst 'load-keyword)
+                               (eq? inst 'define))
+                           (pop)
+                           1))
                       (seq (make-sequence len)))
                  (let lp ((i 0))
                    (if (= i len)
                        `(,inst ,seq)
                        (begin
-                         (sequence-set! seq i (pop))
+                         (sequence-set! seq i (get1 bytes-per-count))
                          (lp (1+ i)))))))
               (else
                ;; fixed length


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]