Fix the cas primitive in riscv and loongarch backend to allow for o…

…ffset value bigger than 12 bits.
maoif · Nov 18, 2023 · 826ea18 · 826ea18
1 parent 398a05b
commit 826ea18
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 14 deletions.
diff --git a/s/loongarch64.ss b/s/loongarch64.ss
@@ -540,12 +540,19 @@
         (with-output-language (L15d Effect)
                               (define add-offset
                                 (lambda (r)
-                                  (if (eqv? (nanopass-case (L15d Triv) w [(immediate ,imm) imm]) 0)
-                                      (k r)
-                                      (let ([u (make-tmp 'u)])
-                                        (seq
-                                         `(set! ,(make-live-info) ,u (asm ,null-info ,asm-add ,r ,w))
-                                         (k u))))))
+                                  (nanopass-case (L15d Triv) w
+                                                 [(immediate ,imm)
+                                                  (if (eqv? imm 0)
+                                                      (k r)
+                                                      (let ([u (make-tmp 'u)])
+                                                        (seq
+                                                         `(set! ,(make-live-info) ,u (asm ,null-info ,asm-add ,r ,w))
+                                                         (k u))))]
+                                                 [else
+                                                  (let ([u (make-tmp 'u)])
+                                                    (seq
+                                                     `(set! ,(make-live-info) ,u (asm ,null-info ,asm-add ,r ,w))
+                                                     (k u)))])))
                               (if (eq? y %zero)
                                   (add-offset x)
                                   (let ([u (make-tmp 'u)])
@@ -570,7 +577,7 @@
                    `(asm ,info ,(asm-lock+/- op) ,r)))])
 
     (define-instruction effect (cas)
-      [(op (x ur) (y ur) (w imm12) (old ur) (new ur))
+      [(op (x ur) (y ur) (w imm12 ur) (old ur) (new ur))
        (lea->reg x y w
                  (lambda (r)
                    `(asm ,info ,asm-cas ,r ,old ,new)))])

diff --git a/s/riscv64.ss b/s/riscv64.ss
@@ -527,12 +527,19 @@
         (with-output-language (L15d Effect)
                               (define add-offset
                                 (lambda (r)
-                                  (if (eqv? (nanopass-case (L15d Triv) w [(immediate ,imm) imm]) 0)
-                                      (k r)
-                                      (let ([u (make-tmp 'u)])
-                                        (seq
-                                         `(set! ,(make-live-info) ,u (asm ,null-info ,asm-add ,r ,w))
-                                         (k u))))))
+                                  (nanopass-case (L15d Triv) w
+                                                 [(immediate ,imm)
+                                                  (if (eqv? imm 0)
+                                                      (k r)
+                                                      (let ([u (make-tmp 'u)])
+                                                        (seq
+                                                         `(set! ,(make-live-info) ,u (asm ,null-info ,asm-add ,r ,w))
+                                                         (k u))))]
+                                                 [else
+                                                  (let ([u (make-tmp 'u)])
+                                                    (seq
+                                                     `(set! ,(make-live-info) ,u (asm ,null-info ,asm-add ,r ,w))
+                                                     (k u)))])))
                               (if (eq? y %zero)
                                   (add-offset x)
                                   (let ([u (make-tmp 'u)])
@@ -563,7 +570,7 @@
                       `(asm ,null-info ,(asm-lock+/- op) ,r ,u1 ,u2)))))])
 
     (define-instruction effect (cas)
-      [(op (x ur) (y ur) (w imm12) (old ur) (new ur))
+      [(op (x ur) (y ur) (w imm12 ur) (old ur) (new ur))
        (lea->reg x y w
                  (lambda (r)
                    (let ([u1 (make-tmp 'u1)] [u2 (make-tmp 'u2)])