make sure all programs are 8-byte aligned

[bpt/guile.git] / module / language / glil / compile-assembly.scm

diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 9a5cae0..2e586ec 100644 (file)
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -137,9 +137,9 @@
 (define (glil->assembly glil toplevel? bindings
                         source-alist label-alist object-alist addr)
   (define (emit-code x)
-    (values (map assembly-pack x) bindings source-alist label-alist object-alist))
+    (values x bindings source-alist label-alist object-alist))
   (define (emit-code/object x object-alist)
-    (values (map assembly-pack x) bindings source-alist label-alist object-alist))
+    (values x bindings source-alist label-alist object-alist))
 
   (record-case glil
     ((<glil-program> nargs nrest nlocs meta body)
@@ -164,10 +164,15 @@
 
      (receive (code bindings sources labels objects len)
          (process-body)
-       (let ((prog `(load-program ,nargs ,nrest ,nlocs ,labels
-                                  ,len
-                                  ,(make-meta bindings sources meta)
-                                  . ,code)))
+       (let* ((meta (make-meta bindings sources meta))
+              (meta-pad (if meta (modulo (- 8 (modulo len 8)) 8) 0))
+              (prog `(load-program ,nargs ,nrest ,nlocs ,labels
+                                  ,(+ len meta-pad)
+                                  ,meta
+                                  ,@code
+                                  ,@(if meta
+                                        (make-list meta-pad '(nop))
+                                        '()))))
          (cond
           (toplevel?
            ;; toplevel bytecode isn't loaded by the vm, no way to do
@@ -175,7 +180,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 +195,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 +377,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)