diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 89b740762..221eb2c0f 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -63,6 +63,27 @@ (emit-mov* . emit-mov) (emit-fmov* . emit-fmov) + emit-u64=? + emit-u64 'br-if-f64->= 'br-if-logtest) _ ... target) (list "-> ~A" (vector-ref labels (- (+ offset target) start)))) + (((or 'j 'je 'jl 'jge 'jne 'jnl 'jnge) target) + (list "-> ~A" (vector-ref labels (- (+ offset target) start)))) + (('immediate-tag=? _ mask tag) + (assoc-ref immediate-tag-annotations (list mask tag))) + (('heap-tag=? _ mask tag) + (assoc-ref heap-tag-annotations (list mask tag))) (('br-if-tc7 slot invert? tc7 target) (list "~A -> ~A" (let ((tag (case tc7 @@ -308,7 +365,8 @@ address of that offset." br-if-= br-if-< br-if-<= br-if-> br-if->= br-if-logtest br-if-u64-= br-if-u64-< br-if-u64-<= br-if-u64-<-scm br-if-u64-<=-scm br-if-u64-=-scm - br-if-u64->-scm br-if-u64->=-scm) + br-if-u64->-scm br-if-u64->=-scm + j je jl jge jne jnl jnge) (match arg ((_ ... target) (add-label! (+ offset target) "L")))) @@ -529,7 +587,8 @@ address of that offset." return-values subr-call foreign-call continuation-call tail-apply - br)) + br + j)) (let ((opcode (logand (bytevector-u32-native-ref code pos) #xff))) (not (bitvector-ref non-fallthrough-set opcode)))) @@ -538,7 +597,7 @@ address of that offset." (syntax-case x () ((_ name opcode kind word0 word* ...) (let ((symname (syntax->datum #'name))) - (if (or (memq symname '(br prompt)) + (if (or (memq symname '(br prompt j je jl jge jne jnl jnge)) (string-prefix? "br-" (symbol->string symname))) (let ((offset (* 4 (length #'(word* ...))))) #`(vector-set!