diff options
Diffstat (limited to 'module/language/assembly/compile-bytecode.scm')
-rw-r--r-- | module/language/assembly/compile-bytecode.scm | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm index e8bba9e7e..5a8098112 100644 --- a/module/language/assembly/compile-bytecode.scm +++ b/module/language/assembly/compile-bytecode.scm @@ -55,6 +55,10 @@ (define (write-uint16-le x) (write-byte (logand x 255)) (write-byte (logand (ash x -8) 255))) + (define (write-uint24-be x) + (write-byte (logand (ash x -16) 255)) + (write-byte (logand (ash x -8) 255)) + (write-byte (logand x 255))) (define (write-uint32-be x) (write-byte (logand (ash x -24) 255)) (write-byte (logand (ash x -16) 255)) @@ -85,12 +89,10 @@ ;; Ew! (for-each write-byte (bytevector->u8-list bv))) (define (write-break label) - (let ((offset (- (assq-ref labels label) - (logand (+ (get-addr) 2) (lognot #x7))))) - (cond ((not (= 0 (modulo offset 8))) (error "unaligned jump" offset)) - ((>= offset (ash 1 18)) (error "jump too far forward" offset)) - ((< offset (- (ash 1 18))) (error "jump too far backwards" offset)) - (else (write-uint16-be (ash offset -3)))))) + (let ((offset (- (assq-ref labels label) (+ (get-addr) 3)))) + (cond ((>= offset (ash 1 23)) (error "jump too far forward" offset)) + ((< offset (- (ash 1 23))) (error "jump too far backwards" offset)) + (else (write-uint24-be offset))))) (let ((inst (car asm)) (args (cdr asm)) |