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 (armv4:r0>>r1-signed): New procedure.
(armv4:instructions): Register it.
* module/mescc/i386/as.scm (i386:r0>>r1-signed): New procedure.
(i386:instructions): Register it.
* module/mescc/riscv64/as.scm (riscv64:r0>>r1-signed): New procedure.
(riscv64:instructions): Register it.
* module/mescc/x86_64/as.scm (x86_64:r0>>r1-signed): New procedure.
(x86_64:instructions): Register it.
(

Author: ekaitz-zarraga

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

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

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

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)

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)))

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)

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)

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)