mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

remove glil->objcode path in favor of passing through assembly; refactorings.

Browse source 
* module/language/assembly.scm: Refactor a bit; remove the name "code"
  from the API, as it's too generic, and replace with "assembly".

* module/language/assembly/compile-bytecode.scm: Get byte lengths via,
  well, byte-length.

* module/language/glil/Makefile.am:
* module/language/glil/spec.scm:
* module/language/glil/compile-objcode.scm: Remove compile-objcode, as we
  just go through bytecode now.

* module/language/glil/compile-assembly.scm (glil->assembly)
  (dump-object): s/object->code/object->assembly/.
This commit is contained in:
Andy Wingo 2009-01-30 11:02:01 +01:00
parent 6f78702819
commit 4b31848284
6 changed files with 34 additions and 449 deletions
Download patch file Download diff file Expand all files Collapse all files

15
module/language/assembly/compile-bytecode.scm
View file

@ -21,27 +21,26 @@
(define-module (language assembly compile-bytecode)
#:use-module (system base pmatch)
#:use-module (language assembly)
#:use-module (system vm instruction)
#:use-module (srfi srfi-4)
#:use-module ((srfi srfi-1) #:select (fold))
#:export (compile-bytecode write-bytecode))
(define *program-header-len* 8)
(define (compile-bytecode assembly env . opts)
(pmatch assembly
((load-program ,nargs ,nrest ,nlocs ,nexts ,labels ,len . ,code)
(letrec ((v (make-u8vector (+ *program-header-len* len)))
((load-program . _)
;; the 1- and -1 are so that we drop the load-program byte
(letrec ((v (make-u8vector (1- (byte-length assembly))))
(i -1)
(write-byte (lambda (b)
;; drop the load-program byte
(if (>= i 0) (u8vector-set! v i b))
(set! i (1+ i))))
(get-addr (lambda () i)))
(write-bytecode assembly write-byte get-addr '())
(if (not (= i (u8vector-length v)))
(error "incorrect length in assembly" i len))
(values v env)))
(if (= i (u8vector-length v))
(values v env)
(error "incorrect length in assembly" i (u8vector-length v)))))
(else (error "bad assembly" assembly))))
(define (write-bytecode asm write-byte get-addr labels)