summaryrefslogtreecommitdiff
path: root/module/system/vm/assembler.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/system/vm/assembler.scm')
-rw-r--r--module/system/vm/assembler.scm135
1 files changed, 88 insertions, 47 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 6bc2bcf84..f29105108 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -89,13 +89,13 @@
emit-br-if-struct
emit-br-if-char
emit-br-if-tc7
- (emit-br-if-eq* . emit-br-if-eq)
- (emit-br-if-eqv* . emit-br-if-eqv)
- (emit-br-if-equal* . emit-br-if-equal)
- (emit-br-if-=* . emit-br-if-=)
- (emit-br-if-<* . emit-br-if-<)
- (emit-br-if-<=* . emit-br-if-<=)
- (emit-br-if-logtest* . emit-br-if-logtest)
+ emit-br-if-eq
+ emit-br-if-eqv
+ emit-br-if-equal
+ emit-br-if-=
+ emit-br-if-<
+ emit-br-if-<=
+ emit-br-if-logtest
(emit-mov* . emit-mov)
(emit-box* . emit-box)
(emit-box-ref* . emit-box-ref)
@@ -153,7 +153,7 @@
(emit-struct-ref* . emit-struct-ref)
(emit-struct-set!* . emit-struct-set!)
(emit-class-of* . emit-class-of)
- (emit-make-array* . emit-make-array)
+ emit-make-array
(emit-bv-u8-ref* . emit-bv-u8-ref)
(emit-bv-s8-ref* . emit-bv-s8-ref)
(emit-bv-u16-ref* . emit-bv-u16-ref)
@@ -510,29 +510,38 @@ later by the linker."
(with-syntax ((opcode opcode))
(op-case
asm type
- ((U8_X24)
+ ((X32)
(emit asm opcode))
- ((U8_U24 arg)
+ ((X8_S24 arg)
(emit asm (pack-u8-u24 opcode arg)))
- ((U8_L24 label)
+ ((X8_F24 arg)
+ (emit asm (pack-u8-u24 opcode arg)))
+ ((X8_C24 arg)
+ (emit asm (pack-u8-u24 opcode arg)))
+ ((X8_L24 label)
(record-label-reference asm label)
(emit asm opcode))
- ((U8_U8_I16 a imm)
+ ((X8_S8_I16 a imm)
(emit asm (pack-u8-u8-u16 opcode a (object-address imm))))
- ((U8_U12_U12 a b)
+ ((X8_S12_S12 a b)
+ (emit asm (pack-u8-u12-u12 opcode a b)))
+ ((X8_S12_C12 a b)
+ (emit asm (pack-u8-u12-u12 opcode a b)))
+ ((X8_C12_C12 a b)
(emit asm (pack-u8-u12-u12 opcode a b)))
- ((U8_U8_U8_U8 a b c)
+ ((X8_F12_F12 a b)
+ (emit asm (pack-u8-u12-u12 opcode a b)))
+ ((X8_S8_S8_S8 a b c)
+ (emit asm (pack-u8-u8-u8-u8 opcode a b c)))
+ ((X8_S8_S8_C8 a b c)
+ (emit asm (pack-u8-u8-u8-u8 opcode a b c)))
+ ((X8_S8_C8_S8 a b c)
(emit asm (pack-u8-u8-u8-u8 opcode a b c))))))
(define (pack-tail-word asm type)
(op-case
asm type
- ((U8_U24 a b)
- (emit asm (pack-u8-u24 a b)))
- ((U8_L24 a label)
- (record-label-reference asm label)
- (emit asm a))
- ((U32 a)
+ ((C32 a)
(emit asm a))
((I32 imm)
(let ((val (object-address imm)))
@@ -548,7 +557,7 @@ later by the linker."
((N32 label)
(record-far-label-reference asm label)
(emit asm 0))
- ((S32 label)
+ ((R32 label)
(record-far-label-reference asm label)
(emit asm 0))
((L32 label)
@@ -558,21 +567,31 @@ later by the linker."
(record-far-label-reference asm label
(* offset (/ (asm-word-size asm) 4)))
(emit asm 0))
- ((X8_U24 a)
- (emit asm (pack-u8-u24 0 a)))
- ((X8_L24 label)
- (record-label-reference asm label)
- (emit asm 0))
+ ((C8_C24 a b)
+ (emit asm (pack-u8-u24 a b)))
((B1_X7_L24 a label)
(record-label-reference asm label)
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
- ((B1_U7_L24 a b label)
+ ((B1_C7_L24 a b label)
(record-label-reference asm label)
(emit asm (pack-u1-u7-u24 (if a 1 0) b 0)))
((B1_X31 a)
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
- ((B1_X7_U24 a b)
- (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b)))))
+ ((B1_X7_S24 a b)
+ (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b)))
+ ((B1_X7_F24 a b)
+ (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b)))
+ ((B1_X7_C24 a b)
+ (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b)))
+ ((X8_S24 a)
+ (emit asm (pack-u8-u24 0 a)))
+ ((X8_F24 a)
+ (emit asm (pack-u8-u24 0 a)))
+ ((X8_C24 a)
+ (emit asm (pack-u8-u24 0 a)))
+ ((X8_L24 label)
+ (record-label-reference asm label)
+ (emit asm 0))))
(syntax-case x ()
((_ name opcode word0 word* ...)
@@ -651,25 +670,44 @@ later by the linker."
#f)))
(op-case
word0
- ((U8_U8_I16 ! a imm)
- (values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253))
- imm))
- ((U8_U8_I16 <- a imm)
+ ((X8_S8_I16 <- a imm)
(values (if (< a (ash 1 8)) a 253)
imm))
- ((U8_U12_U12 ! a b)
+ ((X8_S12_S12 ! a b)
(values (if (< a (ash 1 12)) a (begin (emit-mov* asm 253 a) 253))
(if (< b (ash 1 12)) b (begin (emit-mov* asm 254 b) 254))))
- ((U8_U12_U12 <- a b)
+ ((X8_S12_S12 <- a b)
(values (if (< a (ash 1 12)) a 253)
(if (< b (ash 1 12)) b (begin (emit-mov* asm 254 b) 254))))
- ((U8_U8_U8_U8 ! a b c)
+ ((X8_S12_C12 <- a b)
+ (values (if (< a (ash 1 12)) a 253)
+ b))
+
+ ((X8_S8_S8_S8 ! a b c)
(values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253))
(if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254))
(if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255))))
- ((U8_U8_U8_U8 <- a b c)
+ ((X8_S8_S8_S8 <- a b c)
+ (values (if (< a (ash 1 8)) a 253)
+ (if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254))
+ (if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255))))
+
+ ((X8_S8_S8_C8 ! a b c)
+ (values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253))
+ (if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254))
+ c))
+ ((X8_S8_S8_C8 <- a b c)
(values (if (< a (ash 1 8)) a 253)
(if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254))
+ c))
+
+ ((X8_S8_C8_S8 ! a b c)
+ (values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253))
+ b
+ (if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255))))
+ ((X8_S8_C8_S8 <- a b c)
+ (values (if (< a (ash 1 8)) a 253)
+ b
(if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255))))))
(define (tail-formals type)
@@ -682,22 +720,25 @@ later by the linker."
((op-case type)
(error "unmatched type" type))))
(op-case type
- (U8_U24 a b)
- (U8_L24 a label)
- (U32 a)
+ (C32 a)
(I32 imm)
(A32 imm)
(B32)
(N32 label)
- (S32 label)
+ (R32 label)
(L32 label)
(LO32 label offset)
- (X8_U24 a)
- (X8_L24 label)
+ (C8_C24 a b)
+ (B1_C7_L24 a b label)
+ (B1_X7_S24 a b)
+ (B1_X7_F24 a b)
+ (B1_X7_C24 a b)
(B1_X7_L24 a label)
- (B1_U7_L24 a b label)
(B1_X31 a)
- (B1_X7_U24 a b)))
+ (X8_S24 a)
+ (X8_F24 a)
+ (X8_C24 a)
+ (X8_L24 label)))
(define (shuffle-up dst)
(define-syntax op-case
@@ -711,10 +752,10 @@ later by the linker."
(with-syntax ((dst dst))
(op-case
word0
- ((U8_U8_I16 U8_U8_U8_U8)
+ ((X8_S8_I16 X8_S8_S8_S8 X8_S8_S8_C8 X8_S8_C8_S8)
(unless (< dst (ash 1 8))
(emit-mov* asm dst 253)))
- ((U8_U12_U12)
+ ((X8_S12_S12 X8_S12_C12)
(unless (< dst (ash 1 12))
(emit-mov* asm dst 253))))))
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-22 22:02:20 +0000