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-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 ;;; Copyright © 2023 Andrius Štikonas +;;; Copyright © 2023 Ekaitz Zarraga ;;; Copyright © 2021 W. J. van der Laan ;;; ;;; 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-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-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-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-signed . ,x86_64:r0>>r1-signed) (r1->r0 . ,x86_64:r1->r0) (r2->r0 . ,x86_64:r2->r0) (ret . ,x86_64:ret)