[PATCH] mescc: Add support for signed rotation.

[Ekaitz Zarraga]

>From c0c2556c2b2897814a87b8bdfa6997f79c218eeb Mon Sep 17 00:00:00 2001
From: Ekaitz Zarraga <ekaitz@elenq.tech>
Date: Mon, 11 Sep 2023 17:08:23 +0200
Subject: [PATCH] mescc: Add support for signed rotation.

* module/mescc/compile.scm (expr->register)[rshift, assn-expr]: Add
signed right-rotation support.
* lib/arm-mes/arm.M1 (asr): Add instruction.
* lib/x86-mes/x86.M1 (sar): Add instruction.
* lib/x86_64-mes/x86_64.M1 (sar): Add instruction.
* module/mescc/armv4/as.scm (r0>>r1-signed): Add variable.
* module/mescc/i386/as.scm (r0>>r1-signed): Add variable.
* module/mescc/riscv64/as.scm (r0>>r1-signed): Add variable.
* module/mescc/x86_64/as.scm (r0>>r1-signed): Add variable.
---
 lib/arm-mes/arm.M1          | 1 +
 lib/x86-mes/x86.M1          | 1 +
 lib/x86_64-mes/x86_64.M1    | 1 +
 module/mescc/armv4/as.scm   | 7 ++++++-
 module/mescc/compile.scm    | 5 +++--
 module/mescc/i386/as.scm    | 7 +++++++
 module/mescc/riscv64/as.scm | 6 ++++++
 module/mescc/x86_64/as.scm  | 7 +++++++
 8 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/lib/arm-mes/arm.M1 b/lib/arm-mes/arm.M1
index 384f8776..0830f7d3 100644
--- a/lib/arm-mes/arm.M1
+++ b/lib/arm-mes/arm.M1
@@ -269,6 +269,7 @@ DEFINE lsl____%r0,%r0,%r1 1001a0e1  # lsl %r0, %r0, %r1
 DEFINE lsl____%r0,%r0,$i8 90a0e31009a0e1 # mov     r9, #xx; lsl %r0, %r0, %r9
 DEFINE lsl____%r1,%r1,$i8 90a0e31119a0e1 # mov     r9, #xx; lsl %r1, %r1, %r9
 DEFINE lsr____%r0,%r0,%r1 3001a0e1  # lsr %r0, %r0, %r1
+DEFINE asr____%r0,%r0,%r1 5001a0e1  # asr %r0, %r0, %r1
 DEFINE ldr____%r0,(%sp,#$i8) 009de5  # ldr r0, [r13+xx]
 DEFINE ldr____%r1,(%sp,#$i8) 109de5  # ldr r1, [r13+xx]
 #DEFINE add____%r2,%r0,%r1,lsl#4 012280e0
diff --git a/lib/x86-mes/x86.M1 b/lib/x86-mes/x86.M1
index ede79799..18cc31aa 100644
--- a/lib/x86-mes/x86.M1
+++ b/lib/x86-mes/x86.M1
@@ -199,6 +199,7 @@ DEFINE shl____$i8,%ebx c1e3
 DEFINE shl____%cl,%eax d3e0
 DEFINE shl____%cl,%ebx d3e3
 DEFINE shr____%cl,%eax d3e8
+DEFINE sar____%cl,%eax d3f8
 DEFINE sub____$8,%esp 83ec
 DEFINE sub____$i32,%esp 81ec
 DEFINE sub____%al,%dl 28d0
diff --git a/lib/x86_64-mes/x86_64.M1 b/lib/x86_64-mes/x86_64.M1
index 9df43bc8..50081c66 100644
--- a/lib/x86_64-mes/x86_64.M1
+++ b/lib/x86_64-mes/x86_64.M1
@@ -226,6 +226,7 @@ DEFINE shl____$i8,%rdi 48c1e7
 DEFINE shl____%cl,%rax 48d3e0
 DEFINE shl____%cl,%rdi 48d3e7
 DEFINE shr____%cl,%rax 48d3e8
+DEFINE sar____%cl,%rax 48d3f8
 DEFINE sub____$i32,%rbp 4881ed
 DEFINE sub____$i32,%rsp 4881ec
 DEFINE sub____%rdi,%rax 4829f8
diff --git a/module/mescc/armv4/as.scm b/module/mescc/armv4/as.scm
index 0ee3383b..13be953e 100644
--- a/module/mescc/armv4/as.scm
+++ b/module/mescc/armv4/as.scm
@@ -350,12 +350,16 @@
         (r1 (get-r1 info)))
     `((,(string-append "lsl____%" r0 ",%" r0 ",%" r1)))))
 
-;; FIXME: lsr??! Signed or unsigned r0?
 (define (armv4:r0>>r1 info)
   (let ((r0 (get-r0 info))
         (r1 (get-r1 info)))
     `((,(string-append "lsr____%" r0 ",%" r0 ",%" r1)))))
 
+(define (armv4:r0>>r1-signed info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "asr____%" r0 ",%" r0 ",%" r1)))))
+
 (define (armv4:r0-and-r1 info)
   (let ((r0 (get-r0 info))
         (r1 (get-r1 info)))
@@ -627,6 +631,7 @@
     (r0/r1 . ,armv4:r0/r1)
     (r0<<r1 . ,armv4:r0<<r1)
     (r0>>r1 . ,armv4:r0>>r1)
+    (r0>>r1-signed . ,armv4:r0>>r1-signed)
     (r1->r0 . ,armv4:r1->r0)
     (r2->r0 . ,armv4:r2->r0)
     (ret . ,armv4:ret)
diff --git a/module/mescc/compile.scm b/module/mescc/compile.scm
index 3e316bfb..50df1e6b 100644
--- a/module/mescc/compile.scm
+++ b/module/mescc/compile.scm
@@ -1,6 +1,7 @@
 ;;; GNU Mes --- Maxwell Equations of Software
 ;;; Copyright © 2016,2017,2018,2019,2020,2021 Jan (janneke) Nieuwenhuizen 
<janneke@gnu.org>
 ;;; Copyright © 2023 Andrius Štikonas <andrius@stikonas.eu>
+;;; Copyright © 2023 Ekaitz Zarraga <ekaitz@elenq.tech>
 ;;; Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
 ;;;
 ;;; This file is part of GNU Mes.
@@ -1228,7 +1229,7 @@
                 (default (get-type "default" info))
                 (type (if (> (->size type-a info) (->size default info)) type-a
                              default))
-                (info ((binop->r info) a b 'r0>>r1)))
+                (info ((binop->r info) a b (if (signed? type) 'r0>>r1-signed 
'r0>>r1))))
            (append-text info (convert-r0 info type))))
         ((div ,a ,b)
          ((binop->r info) a b 'r0/r1
@@ -1384,7 +1385,7 @@
                                                                ((equal? op 
"&=") (wrap-as (as info 'r0-and-r1)))
                                                                ((equal? op 
"|=") (wrap-as (as info 'r0-or-r1)))
                                                                ((equal? op 
"^=") (wrap-as (as info 'r0-xor-r1)))
-                                                               ((equal? op 
">>=") (wrap-as (as info 'r0>>r1)))
+                                                               ((equal? op 
">>=") (wrap-as (as info (if signed? 'r0>>r1-signed 'r0>>r1))))
                                                                ((equal? op 
"<<=") (wrap-as (as info 'r0<<r1)))
                                                                (else (error 
(format #f "mescc: op ~a not supported: ~a\n" op o))))))
                                  (info (free-register info)))
diff --git a/module/mescc/i386/as.scm b/module/mescc/i386/as.scm
index c4427d41..8001bcdc 100644
--- a/module/mescc/i386/as.scm
+++ b/module/mescc/i386/as.scm
@@ -350,6 +350,12 @@
     `((,(string-append "mov____%" r1 ",%ecx"))
       (,(string-append "shr____%cl,%" r0)))))
 
+(define (i386:r0>>r1-signed info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "mov____%" r1 ",%ecx"))
+      (,(string-append "shr____%cl,%" r0)))))
+
 (define (i386:r0-and-r1 info)
   (let ((r0 (get-r0 info))
         (r1 (get-r1 info)))
@@ -626,6 +632,7 @@
     (r0/r1 . ,i386:r0/r1)
     (r0<<r1 . ,i386:r0<<r1)
     (r0>>r1 . ,i386:r0>>r1)
+    (r0>>r1-signed . ,i386:r0>>r1-signed)
     (r1->r0 . ,i386:r1->r0)
     (r2->r0 . ,i386:r2->r0)
     (ret . ,i386:ret)
diff --git a/module/mescc/riscv64/as.scm b/module/mescc/riscv64/as.scm
index 9d857831..a8a2f898 100644
--- a/module/mescc/riscv64/as.scm
+++ b/module/mescc/riscv64/as.scm
@@ -463,6 +463,11 @@
         (r1 (get-r1 info)))
     `((,(string-append "rd_" r0 " rs1_" r0 " rs2_" r1 " srl")))))
 
+(define (riscv64:r0>>r1-signed info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "rd_" r0 " rs1_" r0 " rs2_" r1 " sra")))))
+
 ;;; bitwise r0 := r0 & r1
 (define (riscv64:r0-and-r1 info)
   (let ((r0 (get-r0 info))
@@ -739,6 +744,7 @@
     (r0/r1 . ,riscv64:r0/r1)
     (r0<<r1 . ,riscv64:r0<<r1)
     (r0>>r1 . ,riscv64:r0>>r1)
+    (r0>>r1-signed . ,riscv64:r0>>r1-signed)
     (r1->r0 . ,riscv64:r1->r0)
     (r2->r0 . ,riscv64:r2->r0)
     (ret . ,riscv64:ret)
diff --git a/module/mescc/x86_64/as.scm b/module/mescc/x86_64/as.scm
index 56dc2df6..9b1e2755 100644
--- a/module/mescc/x86_64/as.scm
+++ b/module/mescc/x86_64/as.scm
@@ -430,6 +430,12 @@
     `((,(string-append "mov____%" r1 ",%rcx"))
       (,(string-append "shr____%cl,%" r0)))))
 
+(define (x86_64:r0>>r1-signed info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "mov____%" r1 ",%rcx"))
+      (,(string-append "sar____%cl,%" r0)))))
+
 (define (x86_64:r0-and-r1 info)
   (let ((r0 (get-r0 info))
         (r1 (get-r1 info)))
@@ -760,6 +766,7 @@
     (r0/r1 . ,x86_64:r0/r1)
     (r0<<r1 . ,x86_64:r0<<r1)
     (r0>>r1 . ,x86_64:r0>>r1)
+    (r0>>r1-signed . ,x86_64:r0>>r1-signed)
     (r1->r0 . ,x86_64:r1->r0)
     (r2->r0 . ,x86_64:r2->r0)
     (ret . ,x86_64:ret)
-- 
2.41.0