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

speed up compile-bytecode

Browse source 
* module/language/assembly/compile-bytecode.scm (compile-bytecode):
  Rewrite to fill a bytevector directly, instead of using bytevector
  ports.  `write-bytecode' itself is still present and almost the same
  as before; it's just that `write-byte' et al now inline the effect of
  writing a byte to a binary port.

* test-suite/tests/asm-to-bytecode.test (comp-test): Refactor to use
  public interfaces.
This commit is contained in:
Andy Wingo 2011-05-05 11:22:42 +02:00
parent 81f529091b
commit 89f9dd7065
2 changed files with 141 additions and 110 deletions
Download patch file Download diff file Expand all files Collapse all files

14
test-suite/tests/asm-to-bytecode.test
View file

@ -19,11 +19,9 @@
#:use-module ((rnrs io ports) #:select (open-bytevector-output-port))
#:use-module (test-suite lib)
#:use-module (system vm instruction)
#:use-module (language assembly)
#:use-module (language assembly compile-bytecode))
(define write-bytecode
(@@ (language assembly compile-bytecode) write-bytecode))
(define (->u8-list sym val)
(let ((entry (assq-ref `((uint16 2 ,bytevector-u16-native-set!)
(uint32 4 ,bytevector-u32-native-set!))
@ -54,11 +52,11 @@
(run-test `(length ,x) #t
(lambda ()
(call-with-values open-bytevector-output-port
(lambda (port get-bytevector)
(write-bytecode x port '() 0 #t)
(set! v (get-bytevector))
(= (bytevector-length v) len)))))
(let* ((wrapped `(load-program () ,(byte-length x) #f ,x))
(bv (compile-bytecode wrapped '())))
(set! v (make-bytevector (- (bytevector-length bv) 8)))
(bytevector-copy! bv 8 v 0 (bytevector-length v))
(= (bytevector-length v) len))))
(run-test `(compile-equal? ,x ,y) #t
(lambda ()
(equal? v y)))))