mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 04:30:19 +02:00
Code Activity

better alignment

Browse source 
* module/language/assembly.scm (align-program): Whoops, align programs
  properly.

* module/language/glil/compile-assembly.scm (compile-assembly): Start
  with addr=-1, for the unserialized load-program byte.
  (glil->assembly): Align programs in all cases.
This commit is contained in:
Andy Wingo 2009-02-14 22:54:19 +01:00
parent b96dac4d0e
commit 1005628ab5
2 changed files with 6 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

3
module/language/assembly.scm
View file

@ -66,7 +66,8 @@
(define (align-program prog addr) (define (align-program prog addr)
`(,@(make-list (modulo (- *program-alignment* `(,@(make-list (modulo (- *program-alignment*
(modulo addr *program-alignment*)) (modulo (1+ addr) *program-alignment*))
;; plus the one for the load-program inst itself
*program-alignment*) *program-alignment*)
'(nop)) '(nop))
,prog)) ,prog))

7
module/language/glil/compile-assembly.scm
View file

@ -129,7 +129,7 @@
(define (compile-assembly glil) (define (compile-assembly glil)
(receive (code . _) (receive (code . _)
(glil->assembly glil 0 '() '(()) '() '() #f 0) (glil->assembly glil 0 '() '(()) '() '() #f -1)
(car code))) (car code)))
(define (make-object-table objects) (define (make-object-table objects)
(and (not (null? objects)) (and (not (null? objects))
@ -176,7 +176,7 @@
;; toplevel bytecode isn't loaded by the vm, no way to do ;; toplevel bytecode isn't loaded by the vm, no way to do
;; object table or closure capture (not in the bytecode, ;; object table or closure capture (not in the bytecode,
;; anyway) ;; anyway)
(emit-code `(,prog))) (emit-code (align-program prog addr)))
(else (else
(let ((table (dump-object (make-object-table objects) addr)) (let ((table (dump-object (make-object-table objects) addr))
(closure (if (> closure-level 0) '((make-closure)) '()))) (closure (if (> closure-level 0) '((make-closure)) '())))
@ -191,7 +191,8 @@
object-alist))) object-alist)))
(else (else
;; otherwise emit a load directly ;; otherwise emit a load directly
(emit-code `(,@table ,prog ,@closure))))))))))) (emit-code `(,@table ,@(align-program prog (addr+ addr table))
,@closure)))))))))))
((<glil-bind> vars) ((<glil-bind> vars)
(values '() (values '()