summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-07-26 11:54:05 +0200
committerAndy Wingo <wingo@pobox.com>2009-07-26 11:54:05 +0200
commit9efc2d1404aa7705f38aa1ceaebf4c4893e68b83 (patch)
treeb6fa0492aaff5202d1fda7a37b6d5844ead2a515
parent9557ecc6620c83a9254649e63248ce997d749cde (diff)
downloadguile-9efc2d1404aa7705f38aa1ceaebf4c4893e68b83.tar.gz
fix alignment of subprograms of subprograms
* module/language/glil/compile-assembly.scm (glil->assembly) (dump-object): Fix an exciting bug! Subprograms of subprograms were not being aligned correctly, because the code was generated too early. So instead delay dumping the object table until the proper time.
-rw-r--r--module/language/glil/compile-assembly.scm15
1 files changed, 9 insertions, 6 deletions
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 9a5cae04f..c4725e27c 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -175,7 +175,7 @@
;; anyway)
(emit-code (align-program prog addr)))
(else
- (let ((table (dump-object (make-object-table objects) addr)))
+ (let ((table (make-object-table objects)))
(cond
(object-alist
;; if we are being compiled from something with an object
@@ -190,8 +190,10 @@
object-alist)))
(else
;; otherwise emit a load directly
- (emit-code `(,@table ,@(align-program prog (addr+ addr table))))))))))))
-
+ (let ((table-code (dump-object table addr)))
+ (emit-code
+ `(,@table-code
+ ,@(align-program prog (addr+ addr table-code)))))))))))))
((<glil-bind> vars)
(values '()
@@ -370,9 +372,10 @@
((object->assembly x) => list)
((variable-cache-cell? x) (dump-object (variable-cache-cell-key x) addr))
((subprogram? x)
- `(,@(subprogram-table x)
- ,@(align-program (subprogram-prog x)
- (addr+ addr (subprogram-table x)))))
+ (let ((table-code (dump-object (subprogram-table x) addr)))
+ `(,@table-code
+ ,@(align-program (subprogram-prog x)
+ (addr+ addr table-code)))))
((number? x)
`((load-number ,(number->string x))))
((string? x)