Merge remote-tracking branch 'origin/stable-2.0'

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

diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index c315829..bd31930 100644 (file)
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -20,6 +20,7 @@
 
 (define-module (language assembly compile-bytecode)
   #:use-module (system base pmatch)
+  #:use-module (system base target)
   #:use-module (language assembly)
   #:use-module (system vm instruction)
   #:use-module (rnrs bytevectors)
@@ -27,18 +28,16 @@
   #:export (compile-bytecode))
 
 (define (compile-bytecode assembly env . opts)
-  (define-syntax define-inline1
-    (syntax-rules ()
-      ((_ (proc arg) body body* ...)
-       (define-syntax proc
-         (syntax-rules ()
-           ((_ (arg-expr (... ...)))
-            (let ((x (arg-expr (... ...))))
-              (proc x)))
-           ((_ arg)
-            (begin body body* ...)))))))
+  (define-syntax-rule (define-inline1 (proc arg) body body* ...)
+    (define-syntax proc
+      (syntax-rules ()
+        ((_ (arg-expr (... ...)))
+         (let ((x (arg-expr (... ...))))
+           (proc x)))
+        ((_ arg)
+         (begin body body* ...)))))
        
-  (define (fill-bytecode bv)
+  (define (fill-bytecode bv target-endianness)
     (let ((pos 0))
       (define-inline1 (write-byte b)
         (bytevector-u8-set! bv pos b)
@@ -54,7 +53,7 @@
         (bytevector-u32-set! bv pos x (endianness big))
         (set! pos (+ pos 4)))
       (define-inline1 (write-uint32 x)
-        (bytevector-u32-native-set! bv pos x)
+        (bytevector-u32-set! bv pos x target-endianness)
         (set! pos (+ pos 4)))
       (define-inline1 (write-loader-len len)
         (bytevector-u8-set! bv pos (ash len -16))
@@ -77,7 +76,7 @@
           (bytevector-copy! bv* 0 bv pos len)
           (set! pos (+ pos len))))
       (define-inline1 (write-wide-string s)
-        (write-bytevector (string->utf32 s (native-endianness))))
+        (write-bytevector (string->utf32 s target-endianness)))
       (define-inline1 (write-break label)
         (let ((offset (- (assq-ref labels label) (+ (get-addr) 3))))
           (cond ((>= offset (ash 1 23)) (error "jump too far forward" offset))
@@ -134,6 +133,8 @@
               ((br-if-not-eq ,l) (write-break l))
               ((br-if-null ,l) (write-break l))
               ((br-if-not-null ,l) (write-break l))
+              ((br-if-nil ,l) (write-break l))
+              ((br-if-not-nil ,l) (write-break l))
               ((br-if-nargs-ne ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
               ((br-if-nargs-lt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
               ((br-if-nargs-gt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
@@ -160,6 +161,7 @@
      (fill-bytecode (make-bytevector (+ 4 4 length
                                         (if meta
                                             (1- (byte-length meta))
-                                            0)))))
-
+                                            0)))
+                    (target-endianness)))
+    
     (else (error "bad assembly" assembly))))