mescc: RISC-V64 code generation.

* mes/module/mescc/mescc.mes: Import riscv64 code generation modules.
* mes/module/mescc/riscv64/as.mes: Imports for as.mes.
* mes/module/mescc/riscv64/info.mes: Imports for info.mes.
* module/mescc/mescc.scm (replace-suffix, arch-get, arch-get-info,
arch-get-machine, arch-get-m1-macros, .E?, .s?, .o?): Handle riscv64 and
some stubs for riscv32.
(arch-get-defines): Add defines for riscv32 and riscv64.
* module/mescc/riscv64/as.scm: New file: Code generator module for RISC-V64.
* module/mescc/riscv64/info.scm: New file: Architecture info for RISC-V64.
* build-aux/build-guile.sh (SCM_FILES): Add them.

build-aux/build-guile.sh

@@ -2,6 +2,7 @@
 
 # GNU Mes --- Maxwell Equations of Software
 # Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+# Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
 #
 # This file is part of GNU Mes.
 #
@@ -38,6 +39,8 @@ module/mescc/armv4/as.scm
 module/mescc/armv4/info.scm
 module/mescc/i386/as.scm
 module/mescc/i386/info.scm
+module/mescc/riscv64/as.scm
+module/mescc/riscv64/info.scm
 module/mescc/x86_64/as.scm
 module/mescc/x86_64/info.scm
 module/mescc/info.scm

mes/module/mescc/mescc.mes

@@ -28,6 +28,7 @@
 (mes-use-module (mescc armv4 info))
 (mes-use-module (mescc i386 info))
 (mes-use-module (mescc x86_64 info))
+(mes-use-module (mescc riscv64 info))
 (mes-use-module (mescc preprocess))
 (mes-use-module (mescc compile))
 (mes-use-module (mescc M1))

mes/module/mescc/riscv64/as.mes

@@ -0,0 +1,24 @@
+;;; -*-scheme-*-
+
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mescc as))
+(mes-use-module (mescc info))
+(mes-use-module (mescc riscv64 info))
+(include-from-path "mescc/riscv64/as.scm")

mes/module/mescc/riscv64/info.mes

@@ -0,0 +1,23 @@
+;;; -*-scheme-*-
+
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mescc info))
+(mes-use-module (mescc riscv64 as))
+(include-from-path "mescc/riscv64/info.scm")

module/mescc/mescc.scm

@@ -28,6 +28,7 @@
   #:use-module (mescc armv4 info)
   #:use-module (mescc i386 info)
   #:use-module (mescc x86_64 info)
+  #:use-module (mescc riscv64 info)
   #:use-module (mescc preprocess)
   #:use-module (mescc compile)
   #:use-module (mescc M1)
@@ -259,6 +260,7 @@
          (program-prefix (cond ((string-prefix? "arm-mes-" old-suffix) ".arm-mes-")
                                ((string-prefix? "x86-mes-" old-suffix) ".x86-mes-")
                                ((string-prefix? "x86_64-mes-" old-suffix) ".x86_64-mes-")
+                               ((string-prefix? "riscv64-mes-" old-suffix) ".riscv64-mes-")
                                (else "."))))
     (if (string-null? suffix)
         (if (string-null? program-prefix) (string-join base ".")
@@ -316,7 +318,9 @@
     (if machine (cond ((member arch '("x86" "x86_64")) (cond ((equal? machine "32") "x86")
                                                              ((equal? machine "64") "x86_64")))
                       ((equal? arch "arm") (cond ((equal? machine "32") "arm")
-                                                 ((equal? machine "arm") "arm"))))
+                                                 ((equal? machine "arm") "arm")))
+                      ((member arch '("riscv32" "riscv64")) (cond ((equal? machine "32") "riscv32")
+                                                                  ((equal? machine "64") "riscv64"))))
         arch)))
 
 (define (mescc:get-host options)
@@ -328,7 +332,8 @@
   (let ((arch (arch-get options)))
     (cond ((equal? arch "arm") (armv4-info))
           ((equal? arch "x86") (x86-info))
-          ((equal? arch "x86_64") (x86_64-info)))))
+          ((equal? arch "x86_64") (x86_64-info))
+          ((equal? arch "riscv64") (riscv64-info)))))
 
 (define (arch-get-defines options)
   (let* ((arch (arch-get options))
@@ -339,12 +344,16 @@
     (let ((int (sizeof "int"))
           (long (sizeof "long"))
           (long-long (sizeof "long long")))
-      (cons (cond ((equal? arch "arm")
+      (append (cond ((equal? arch "arm")
-                   "__arm__=1")
+                   '("__arm__=1"))
                   ((equal? arch "x86")
-                   "__i386__=1")
+                   '("__i386__=1"))
                   ((equal? arch "x86_64")
-                   "__x86_64__=1"))
+                   '("__x86_64__=1"))
+                  ((equal? arch "riscv32")
+                   '("__riscv=1" "__riscv_xlen=32"))
+                  ((equal? arch "riscv64")
+                   '("__riscv=1" "__riscv_xlen=64")))
             `(,(string-append "__SIZEOF_INT__=" (number->string int))
               ,(string-append "__SIZEOF_LONG__=" (number->string long))
               ,@(if (< long-long 8) '() ;C99: long long must be >= 8
@@ -354,7 +363,7 @@
   (let* ((machine (option-ref options 'machine #f))
          (arch (option-ref options 'arch #f))
          (machine (or machine arch "32")))
-    (cond ((member machine '("64" "x86_64")) "64")
+    (cond ((member machine '("64" "riscv64" "x86_64")) "64")
           ((member machine '("arm")) "32")
           (else "32"))))
 
@@ -362,14 +371,16 @@
   (let ((arch (arch-get options)))
     (cond ((equal? arch "arm") "arm.M1")
           ((equal? arch "x86") "x86.M1")
-          ((equal? arch "x86_64") "x86_64.M1"))))
+          ((equal? arch "x86_64") "x86_64.M1")
+          ((equal? arch "riscv64") "riscv64.M1"))))
 
 (define (arch-get-architecture options)
   (let ((arch (arch-get options)))
     (list "--architecture"
           (cond ((equal? arch "arm") "armv7l")
                 ((equal? arch "x86") "x86")
-                ((equal? arch "x86_64") "amd64")))))
+                ((equal? arch "x86_64") "amd64")
+                ((equal? arch "riscv64") "riscv64")))))
 
 (define (multi-opt option-name) (lambda (o) (and (eq? (car o) option-name) (cdr o))))
 (define (count-opt options option-name)
@@ -382,17 +393,23 @@
                     (string-suffix? ".mes-E" o)
                     (string-suffix? ".arm-mes-E" o)
                     (string-suffix? ".x86-mes-E" o)
-                    (string-suffix? ".x86_64-mes-E" o)))
+                    (string-suffix? ".x86_64-mes-E" o)
+                    (string-suffix? ".riscv32-mes-E" o)
+                    (string-suffix? ".riscv64-mes-E" o)))
 (define (.s? o) (or (string-suffix? ".s" o)
                     (string-suffix? ".S" o)
                     (string-suffix? ".mes-S" o)
                     (string-suffix? ".arm-mes-S" o)
                     (string-suffix? ".x86-mes-S" o)
                     (string-suffix? ".x86_64-mes-S" o)
+                    (string-suffix? ".riscv32-mes-S" o)
+                    (string-suffix? ".riscv64-mes-S" o)
                     (string-suffix? ".M1" o)))
 (define (.o? o) (or (string-suffix? ".o" o)
                     (string-suffix? ".mes-o" o)
                     (string-suffix? ".arm-mes-o" o)
                     (string-suffix? ".x86-mes-o" o)
                     (string-suffix? ".x86_64-mes-o" o)
+                    (string-suffix? ".riscv32-mes-o" o)
+                    (string-suffix? ".riscv64-mes-o" o)
                     (string-suffix? ".hex2" o)))

module/mescc/riscv64/as.scm

@@ -0,0 +1,737 @@
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Define riscv64 M1 assembly
+
+;;; Code:
+
+(define-module (mescc riscv64 as)
+  #:use-module (mes guile)
+  #:use-module (mescc as)
+  #:use-module (mescc info)
+  #:use-module (mescc riscv64 info)
+  #:export (
+            riscv64:instructions
+            ))
+
+;;; reserved temporary intermediate registers
+; t6 is used internally by M1 sequences
+; t4 and t5 are scratch registers for code generation here
+(define %tmpreg1 "t5")
+(define %tmpreg2 "t4")
+; registers for condition flags emulation
+(define %condregx "s10")
+(define %condregy "s11")
+
+;;; register for return values
+(define %retreg "t0")
+
+;;; internal: return instruction to load an intermediate value into a register
+(define (riscv64:li r v)
+  (cond
+    ((= v 0)
+      `(,(string-append "mv_____%" r ",%x0")))
+    ((and (>= v (- #x8000)) (<= v #x7fff))
+      `(,(string-append "li_____%" r ",$i16_0000") (#:immediate2 ,v)
+        ,(string-append "srai___%" r ",16")))
+    ((and (>= v (- #x80000000)) (<= v #x7fffffff))
+      `(,(string-append "li_____%" r ",$i32") (#:immediate ,v)))
+    (else
+      `(,(string-append "li_____%" r ",$i64") (#:immediate8 ,v)))))
+
+;;; internal: return instruction to add an intermediate value into a register
+(define (riscv64:addi r0 r1 v)
+  (cond
+    ((= v 0)
+      `(,(string-append "; addi___%" r0 ",%" r1 ",0"))) ; nothing to do
+    ((= v 1)
+      `(,(string-append "addi___%" r0 ",%" r1 ",1")))
+    ((= v -1)
+      `(,(string-append "addi___%" r0 ",%" r1 ",-1")))
+    ((and (>= v (- #x800)) (<= v #x7ff) (= (logand v 15) 0))
+      `(,(string-append "addi___%" r0 ",%" r1 ",$i8_0") (#:immediate1 ,(ash v -4))))
+    ((and (>= v (- #x800)) (<= v #x7ff) (= (logand v 15) 8))
+      `(,(string-append "addi___%" r0 ",%" r1 ",$i8_8") (#:immediate1 ,(ash v -4))))
+    ((and (>= v (- #x80000000)) (<= v #x7fffffff))
+      `(,(string-append "addi___%" r0 ",%" r1 ",$i32") (#:immediate ,v)))
+    (else
+      `(,(string-append "addi___%" r0 ",%" r1 ",$i64") (#:immediate8 ,v)))))
+
+;;; the preamble of every function
+(define (riscv64:function-preamble info . rest)
+  `(("push___%ra")
+    ("push___%fp")
+    ("mv_____%fp,%sp")))
+
+;;; allocate function locals
+(define (riscv64:function-locals . rest)
+  `(
+    ,(riscv64:addi "sp" "sp" (- (+ (* 4 1025) (* 20 8))))
+    )) ; 4*1024 buf, 20 local vars
+
+;;; immediate value to register
+(define (riscv64:value->r info v)
+  (or v (error "invalid value: riscv64:value->r: " v))
+  (let ((r (get-r info)))
+    `(,(riscv64:li r v))))
+
+;;; assign immediate value to r0
+(define (riscv64:value->r0 info v)
+  (let ((r0 (get-r0 info)))
+    `(,(riscv64:li r0 v))))
+
+;;; function epilogue
+(define (riscv64:ret . rest)
+  '(("mv_____%sp,%fp")
+    ("pop____%fp")
+    ("pop____%ra")
+    ("ret")))
+
+;;; stack local to register
+(define (riscv64:local->r info n)
+  (let ((r (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
+        (n (- 0 (* 8 n))))
+    `(,(riscv64:addi %tmpreg1 "fp" n)
+      (,(string-append "ld_____%" r ",0(%" %tmpreg1 ")")))))
+
+;;; call a function through a label
+(define (riscv64:call-label info label n)
+  `(("jal.a__$i32" (#:address ,label))
+    ,(riscv64:addi "sp" "sp" (* n 8))
+    ))
+
+;;; call function pointer in register
+(define (riscv64:call-r info n)
+  (let ((r (get-r info)))
+    `((,(string-append "jalr___%" r))
+      ,(riscv64:addi "sp" "sp" (* n 8)))))
+
+;;; register to function argument.
+(define (riscv64:r->arg info i)
+  (let ((r (get-r info)))
+    `((,(string-append "push___%" r)))))
+
+;;; label to function argument
+(define (riscv64:label->arg info label i)
+  `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:address ,label))
+    (,(string-append "push___%" %tmpreg1)))) ; FIXME 64bit
+
+;;; ALU: r0 := r0 + r1
+(define (riscv64:r0+r1 info)
+  (let ((r1 (get-r1 info))
+        (r0 (get-r0 info)))
+    `((,(string-append "add____%" r0 ",%" r0 ",%" r1)))))
+
+;;; ALU: r0 := r0 - r1
+(define (riscv64:r0-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "sub____%" r0 ",%" r0 ",%" r1)))))
+
+;;; add immediate value to r0
+(define (riscv64:r0+value info v)
+  (let ((r0 (get-r0 info)))
+    `(,(riscv64:addi r0 r0 v))))
+
+;;; add immediate to contents of 8-bit word addressed by register
+(define (riscv64:r-byte-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "lb_____%" %tmpreg1 ",0(%" r ")"))
+      ,(riscv64:addi %tmpreg1 %tmpreg1 v)
+      (,(string-append "sb_____%" %tmpreg1 ",0(%" r ")")))))
+
+;;; add immediate to contents of 16-bit word addressed by register
+(define (riscv64:r-word-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "lh_____%" %tmpreg1 ",0(%" r ")"))
+      ,(riscv64:addi %tmpreg1 %tmpreg1 v)
+      (,(string-append "sh_____%" %tmpreg1 ",0(%" r ")")))))
+
+;;; add immediate to contents of 32-bit word addressed by register
+(define (riscv64:r-long-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "lw_____%" %tmpreg1 ",0(%" r ")"))
+      ,(riscv64:addi %tmpreg1 %tmpreg1 v)
+      (,(string-append "sw_____%" %tmpreg1 ",0(%" r ")")))))
+
+;;; add immediate to contents of 64-bit word addressed by register
+(define (riscv64:r-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "ld_____%" %tmpreg1 ",0(%" r ")"))
+      ,(riscv64:addi %tmpreg1 %tmpreg1 v)
+      (,(string-append "sd_____%" %tmpreg1 ",0(%" r ")")))))
+
+;;; compute address of local variable and write result into register
+(define (riscv64:local-ptr->r info n)
+  (let ((r (get-r info))
+        (n (- 0 (* 8 n))))
+      `((,(string-append "mv_____%" r ",%fp"))
+        ,(riscv64:addi r r n))))
+
+;;; label address into register
+(define (riscv64:label->r info label)
+  (let ((r (get-r info)))
+    `((,(string-append "li_____%" r ",$i32") (#:address ,label))))) ;; FIXME 64bit
+
+;;; copy register r0 to register r1 (see also r1->r0)
+(define (riscv64:r0->r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append  "mv_____%" r1 ",%" r0)))))
+
+;;; copy register r1 to register r0 (see also r0->r1)
+(define (riscv64:r1->r0 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append  "mv_____%" r0 ",%" r1)))))
+
+;;; zero-extend 8-bit in register r
+(define (riscv64:byte-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "ext.b__%" r)))))
+
+;;; sign-extend 8-bit in register r
+(define (riscv64:byte-signed-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sext.b_%" r)))))
+
+;;; zero-extend 16-bit in register r
+(define (riscv64:word-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "ext.h__%" r)))))
+
+;;; sign-extend 16-bit in register r
+(define (riscv64:word-signed-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sext.h_%" r)))))
+
+;;; zero-extend 32-bit in register r
+(define (riscv64:long-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "ext.w__%" r)))))
+
+;;; sign-extend 32-bit in register r
+(define (riscv64:long-signed-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sext.w_%" r)))))
+
+;;; unconditional jump to label
+(define (riscv64:jump info label)
+  `(("j.a____$i32 " (#:address ,label))))
+
+;;;; Flag setters ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; test if a register is zero, set z flag accordingly
+;;; see also test-r
+(define (riscv64:r-zero? info)
+  (let ((r (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
+    `((,(string-append "mv_____%" %condregx ",%" r))
+      ,(riscv64:li %condregy 0))))
+
+;;; test register r against 0 and set flags
+;;; this is used for jump-* and cc?->r:
+;;; z (both)
+;;; g ge l le (signed)
+;;; a ae b be (unsigned)
+(define (riscv64:test-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "mv_____%" %condregx ",%" r))
+      ,(riscv64:li %condregy 0))))
+
+;;; negate zero flag
+(define (riscv64:xor-zf info)
+  '(("cond.nz")))
+
+;;; compare register to immediate value and set flags (see test-r)
+(define (riscv64:r-cmp-value info v)
+  (let ((r (get-r info)))
+    `((,(string-append "mv_____%" %condregx ",%" r))
+      ,(riscv64:li %condregy v))))
+
+;;; compare register to another register and set flags (see test-r)
+(define (riscv64:r0-cmp-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "mv_____%" %condregx ",%" r0))
+      (,(string-append "mv_____%" %condregy ",%" r1)))))
+
+;;;; Flag users ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; flag-based conditional jumps (equality)
+(define (riscv64:jump-nz info label)
+  `(("jne.a__$i32" (#:address ,label))))
+
+(define (riscv64:jump-z info label)
+  `(("jeq.a__$i32" (#:address ,label))))
+
+; assuming the result was properly zero/sign-extended, this is the same as a
+; normal jump-z
+(define (riscv64:jump-byte-z info label)
+  `(("jeq.a__$i32" (#:address ,label))))
+
+;;; zero flag to register
+(define (riscv64:zf->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "seq____%" r)))))
+
+;;; boolean: r := !e
+(define (riscv64:r-negate info)
+  (let ((r (get-r info)))
+    `((,(string-append "seq____%" r)))))
+
+;; flag-based conditional setters (signed)
+(define (riscv64:g?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sgt____%" r)))))
+
+(define (riscv64:ge?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sge____%" r)))))
+
+(define (riscv64:l?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "slt____%" r)))))
+
+(define (riscv64:le?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sle____%" r)))))
+
+;; flag-based conditional setters (unsigned)
+(define (riscv64:a?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sgtu___%" r)))))
+
+(define (riscv64:ae?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sgeu___%" r)))))
+
+(define (riscv64:b?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sltu___%" r)))))
+
+(define (riscv64:be?->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "sleu___%" r)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; store lower 8-bit of r0 at address r1
+(define (riscv64:byte-r0->r1-mem info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "sb_____%" r0 ",0(%" r1 ")")))))
+
+;;; load word at label into register r
+(define (riscv64:label-mem->r info label)
+  (let ((r (get-r info)))
+    `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:address ,label))
+      (,(string-append "ld_____%" r ",0(%" %tmpreg1 ")"))))) ;; FIXME 64bit
+
+;;; read 8-bit (and zero-extend) from address in register r into register r
+(define (riscv64:byte-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "lbu____%" r ",0(%" r ")")))))
+
+;;; read 16-bit (and zero-extend) from address in register r into register r
+(define (riscv64:word-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "lhu____%" r ",0(%" r ")")))))
+
+;;; read 32-bit (and zero-extend) from address in register r into register r
+(define (riscv64:long-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "lwu____%" r ",0(%" r ")")))))
+
+;;; read 64-bit from address in register r into register r
+(define (riscv64:mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "ld_____%" r ",0(%" r ")")))))
+
+(define (riscv64:local-add info n v)
+  (let ((n (- 0 (* 8 n))))
+    `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:immediate ,n))
+      (,(string-append "add____%" %tmpreg1 ",%" %tmpreg1 ",%fp"))
+      (,(string-append "ld_____%" %tmpreg2 ",0(%" %tmpreg1 ")"))
+      ,(riscv64:addi %tmpreg2 %tmpreg2 v)
+      (,(string-append "sd_____%" %tmpreg2 ",0(%" %tmpreg1 ")")))))
+
+(define (riscv64:label-mem-add info label v)
+  `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:address ,label))
+    (,(string-append "ld_____%" %tmpreg2 ",0(%" %tmpreg1 ")"))
+    ,(riscv64:addi %tmpreg2 %tmpreg2 v)
+    (,(string-append "sd_____%" %tmpreg2 ",0(%" %tmpreg1 ")"))))
+
+;; no-operation
+(define (riscv64:nop info)
+  '(("nop")))
+
+;; swap the contents of register r0 and r1
+(define (riscv64:swap-r0-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "mv_____%" %tmpreg1 ",%" r1))
+      (,(string-append "mv_____%" r1 ",%" r0))
+      (,(string-append "mv_____%" r0 ",%" %tmpreg1)))))
+
+;;; write 8-bit from register r to memory at the label
+(define (riscv64:r->byte-label info label)
+  (let ((r (get-r info)))
+    `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:address ,label))
+      (,(string-append "sb_____%" r ",0(%" %tmpreg1 ")"))))) ;; FIXME 64bit
+
+;;; write 16-bit from register r to memory at the label
+(define (riscv64:r->word-label info label)
+  (let ((r (get-r info)))
+    `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:address ,label))
+      (,(string-append "sh_____%" r ",0(%" %tmpreg1 ")"))))) ;; FIXME 64bit
+
+;;; write 32-bit from register r to memory at the label
+(define (riscv64:r->long-label info label)
+  (let ((r (get-r info)))
+    `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:address ,label))
+      (,(string-append "sw_____%" r ",0(%" %tmpreg1 ")"))))) ;; FIXME 64bit
+
+;;; write 64-bit from register r to memory at the label
+(define (riscv64:r->label info label)
+  (let ((r (get-r info)))
+    `((,(string-append "li_____%" %tmpreg1 ",$i32") (#:address ,label))
+      (,(string-append "sd_____%" r ",0(%" %tmpreg1 ")"))))) ;; FIXME 64bit
+
+;;; ALU r0 := r0 * r1
+(define (riscv64:r0*r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "mul____%" r0 ",%" r0 ",%" r1)))))
+
+;;; bitwise r0 := r0 << r1
+(define (riscv64:r0<<r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "sll____%" r0 ",%" r0 ",%" r1)))))
+
+;;; bitwise r0 := r0 << imm
+(define (riscv64:shl-r info n)
+  (let ((r (get-r info)))
+    `(,(riscv64:li %tmpreg1 n)
+      (,(string-append "sll____%" r ",%" r ",%" %tmpreg1)))))
+
+;;; bitwise r0 := r0 >> r1 (logical, so shift in zero bits)
+(define (riscv64:r0>>r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "srl____%" r0 ",%" r0 ",%" r1)))))
+
+;;; bitwise r0 := r0 & r1
+(define (riscv64:r0-and-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "and____%" r0 ",%" r0 ",%" r1)))))
+
+;;; bitwise r0 := r0 | r1
+(define (riscv64:r0-or-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "or_____%" r0 ",%" r0 ",%" r1)))))
+
+;;; bitwise r := r & imm
+(define (riscv64:r-and info n)
+  (let ((r (get-r info)))
+    `(,(riscv64:li %tmpreg1 n)
+      (,(string-append "and____%" r ",%" r ",%" %tmpreg1)))))
+
+;;; bitwise r0 := r0 ^ r1
+(define (riscv64:r0-xor-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "xor____%" r0 ",%" r0 ",%" r1)))))
+
+;;; ALU r0 := r0 / r1
+(define (riscv64:r0/r1 info signed?)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "div____%" r0 ",%" r0 ",%" r1)))))
+
+;;; ALU r0 := r0 % r1
+(define (riscv64:r0%r1 info signed?)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "rem____%" r0 ",%" r0 ",%" r1)))))
+
+;;; ALU r0 := r0 + imm
+(define (riscv64:r+value info v)
+  (let ((r (get-r info)))
+    `(,(riscv64:addi r r v))))
+
+;;; store 8-bit r0 into address ported by r1
+(define (riscv64:byte-r0->r1-mem info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "sb_____%" r0 ",0(%" r1 ")")))))
+
+;;; store 16-bit r0 into address ported by r1
+(define (riscv64:word-r0->r1-mem info)
+  (let ((r0 (get-r0 info))
+         (r1 (get-r1 info)))
+    `((,(string-append "sh_____%" r0 ",0(%" r1 ")")))))
+
+;;; store 32-bit r0 into address ported by r1
+(define (riscv64:long-r0->r1-mem info)
+  (let ((r0 (get-r0 info))
+         (r1 (get-r1 info)))
+    `((,(string-append "sw_____%" r0 ",0(%" r1 ")")))))
+
+;;; store 64-bit r0 into address ported by r1
+(define (riscv64:r0->r1-mem info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "sd_____%" r0 ",0(%" r1 ")")))))
+
+;;; push register to stack
+(define (riscv64:push-register info r)
+  `((,(string-append "push___%" r))))
+
+;;; push register r0 to stack (see also push-register)
+(define (riscv64:push-r0 info)
+  (let ((r0 (get-r0 info)))
+    `((,(string-append "push___%" r0)))))
+
+;;; pop register from stack
+(define (riscv64:pop-register info r)
+  `((,(string-append "pop____%" r))))
+
+;;; pop register r0 from stack (see also pop-register)
+(define (riscv64:pop-r0 info)
+  (let ((r0 (get-r0 info)))
+    `((,(string-append "pop____%" r0)))))
+
+;;; get function return value
+(define (riscv64:return->r info)
+  (let ((r (car (.allocated info))))
+    (if (equal? r %retreg) '()
+        `((,(string-append "mv_____%" r ",%" %retreg))))))
+
+;;; bitwise r := r + r (doubling)
+(define (riscv64:r+r info)
+  (let ((r (get-r info)))
+    `((,(string-append "add____%" r ",%" r ",%" r)))))
+
+;;; bitwise r := ~r
+(define (riscv64:not-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "not____%" r ",%" r)))))
+
+;;; load 8-bit at address r0, store to address r1
+(define (riscv64:byte-r0-mem->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info)))
+    `((,(string-append "lb_____%" %tmpreg1 ",0(%" r0 ")"))
+      (,(string-append "sb_____%" %tmpreg1 ",0(%" r1 ")")))))
+
+;;; load 16-bit at address r0, store to address r1
+(define (riscv64:word-r0-mem->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info)))
+    `((,(string-append "lh_____%" %tmpreg1 ",0(%" r0 ")"))
+      (,(string-append "sh_____%" %tmpreg1 ",0(%" r1 ")")))))
+
+;;; load 32-bit at address r0, store to address r1
+(define (riscv64:long-r0-mem->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info)))
+    `((,(string-append "lw_____%" %tmpreg1 ",0(%" r0 ")"))
+      (,(string-append "sw_____%" %tmpreg1 ",0(%" r1 ")")))))
+
+;;; load 64-bit at address r0, store to address r1
+(define (riscv64:r0-mem->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info)))
+    `((,(string-append "ld_____%" %tmpreg1 ",0(%" r0 ")"))
+      (,(string-append "sd_____%" %tmpreg1 ",0(%" r1 ")")))))
+
+;;; register (8-bit) to stack local
+(define (riscv64:byte-r->local+n info id n)
+  (let ((n (+ (- 0 (* 8 id)) n))
+         (r (get-r info)))
+    `(,(riscv64:addi %tmpreg1 "fp" n)
+      (,(string-append "sb_____%" r ",0(%" %tmpreg1 ")")))))
+
+;;; register (16-bit) to stack local
+(define (riscv64:word-r->local+n info id n)
+  (let ((n (+ (- 0 (* 8 id)) n))
+         (r (get-r info)))
+    `(,(riscv64:addi %tmpreg1 "fp" n)
+      (,(string-append "sh_____%" r ",0(%" %tmpreg1 ")")))))
+
+;;; register (32-bit) to stack local
+(define (riscv64:long-r->local+n info id n)
+  (let ((n (+ (- 0 (* 8 id)) n))
+         (r (get-r info)))
+    `(,(riscv64:addi %tmpreg1 "fp" n)
+      (,(string-append "sw_____%" r ",0(%" %tmpreg1 ")")))))
+
+;;; register (64-bit) to stack local
+(define (riscv64:r->local info n)
+  (let ((r (get-r info))
+        (n (- 0 (* 8 n))))
+    `(,(riscv64:addi %tmpreg1 "fp" n)
+      (,(string-append "sd_____%" r ",0(%" %tmpreg1 ")")))))
+
+;;; register (64-bit) to stack local (how does this differ from r->local ?)
+;;; n is computed differently
+(define (riscv64:r->local+n info id n)
+  (let ((n (+ (- 0 (* 8 id)) n))
+         (r (get-r info)))
+    `(,(riscv64:addi %tmpreg1 "fp" n)
+      (,(string-append "sd_____%" r ",0(%" %tmpreg1 ")")))))
+
+;;; swap value of register r with the top word of the stack
+;; seems unused
+(define (riscv64:swap-r-stack info)
+  (let ((r (get-r info)))
+    `((,(string-append "ld_____%" %tmpreg1 ",0(%sp)"))
+      (,(string-append "sd_____%" r ",0(%sp)"))
+      (,(string-append "mv_____%" r ",%" %tmpreg1)))))
+
+;;; swap value of register r0 (not r1) with the top word of the stack
+;; used in expr->arg
+(define (riscv64:swap-r1-stack info)
+  (let ((r0 (get-r0 info)))
+    `((,(string-append "ld_____%" %tmpreg1 ",0(%sp)"))
+      (,(string-append "sd_____%" r0 ",0(%sp)"))
+      (,(string-append "mv_____%" r0 ",%" %tmpreg1)))))
+
+;;; not entirely sure what this is supposed to do
+;;; i guess the idea would be to copy register r2 to r1, but what is the pop/push about?
+(define (riscv64:r2->r0 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info))
+        (allocated (.allocated info)))
+    (if (> (length allocated) 2)
+        (let ((r2 (cadddr allocated)))
+          `((,(string-append  "mv_____%" r1 ",%" r2))))
+        `((,(string-append  "pop____%" r0))
+          (,(string-append  "push___%" r0))))))
+
+(define riscv64:instructions
+  `(
+    (a?->r . ,riscv64:a?->r)
+    (ae?->r . ,riscv64:ae?->r)
+    (b?->r . ,riscv64:b?->r)
+    (be?->r . ,riscv64:be?->r)
+    (byte-mem->r . ,riscv64:byte-mem->r)
+    (byte-r . ,riscv64:byte-r)
+    (byte-r->local+n . ,riscv64:byte-r->local+n)
+    (byte-r0->r1-mem . ,riscv64:byte-r0->r1-mem)
+    (byte-r0-mem->r1-mem . ,riscv64:byte-r0-mem->r1-mem)
+    (byte-signed-r . ,riscv64:byte-signed-r)
+    (call-label . ,riscv64:call-label)
+    (call-r . ,riscv64:call-r)
+    (function-locals . ,riscv64:function-locals)
+    (function-preamble . ,riscv64:function-preamble)
+    (g?->r . ,riscv64:g?->r)
+    (ge?->r . ,riscv64:ge?->r)
+    (jump . ,riscv64:jump)
+;   (jump-a . ,riscv64:jump-a)
+;   (jump-ae . ,riscv64:jump-ae)
+;   (jump-b . ,riscv64:jump-b)
+;   (jump-be . ,riscv64:jump-be)
+    (jump-byte-z . ,riscv64:jump-byte-z)
+;   (jump-g . , riscv64:jump-g)
+;   (jump-ge . , riscv64:jump-ge)
+;   (jump-l . ,riscv64:jump-l)
+;   (jump-le . ,riscv64:jump-le)
+    (jump-nz . ,riscv64:jump-nz)
+    (jump-z . ,riscv64:jump-z)
+    (l?->r . ,riscv64:l?->r)
+    (label->arg . ,riscv64:label->arg)
+    (label->r . ,riscv64:label->r)
+    (label-mem->r . ,riscv64:label-mem->r)
+    (label-mem-add . ,riscv64:label-mem-add)
+    (le?->r . ,riscv64:le?->r)
+    (local->r . ,riscv64:local->r)
+    (local-add . ,riscv64:local-add)
+    (local-ptr->r . ,riscv64:local-ptr->r)
+    (long-mem->r . ,riscv64:long-mem->r)
+    (long-r . ,riscv64:long-r)
+    (long-r->local+n . ,riscv64:long-r->local+n)
+    (long-r0->r1-mem . ,riscv64:long-r0->r1-mem)
+    (long-r0-mem->r1-mem . ,riscv64:long-r0-mem->r1-mem)
+    (long-signed-r . ,riscv64:long-signed-r)
+    (mem->r . ,riscv64:mem->r)
+    (nop . ,riscv64:nop)
+    (not-r . ,riscv64:not-r)
+    (pop-r0 . ,riscv64:pop-r0)
+    (pop-register . ,riscv64:pop-register)
+    (push-r0 . ,riscv64:push-r0)
+    (push-register . ,riscv64:push-register)
+    (quad-r0->r1-mem . ,riscv64:r0->r1-mem)
+    (r+r . ,riscv64:r+r)
+    (r+value . ,riscv64:r+value)
+    (r->arg . ,riscv64:r->arg)
+    (r->byte-label . ,riscv64:r->byte-label)
+    (r->label . ,riscv64:r->label)
+    (r->local . ,riscv64:r->local)
+    (r->local+n . ,riscv64:r->local+n)
+    (r->long-label . ,riscv64:r->long-label)
+    (r->word-label . ,riscv64:r->word-label)
+    (r-and . ,riscv64:r-and)
+    (r-byte-mem-add . ,riscv64:r-byte-mem-add)
+    (r-cmp-value . ,riscv64:r-cmp-value)
+    (r-long-mem-add . ,riscv64:r-long-mem-add)
+    (r-mem-add . ,riscv64:r-mem-add)
+    (r-negate . ,riscv64:r-negate)
+    (r-word-mem-add . ,riscv64:r-word-mem-add)
+    (r-zero? . ,riscv64:r-zero?)
+    (r0%r1 . ,riscv64:r0%r1)
+    (r0*r1 . ,riscv64:r0*r1)
+    (r0+r1 . ,riscv64:r0+r1)
+    (r0+value . ,riscv64:r0+value)
+    (r0->r1 . ,riscv64:r0->r1)
+    (r0->r1-mem . ,riscv64:r0->r1-mem)
+    (r0-and-r1 . ,riscv64:r0-and-r1)
+    (r0-cmp-r1 . ,riscv64:r0-cmp-r1)
+    (r0-mem->r1-mem . ,riscv64:r0-mem->r1-mem)
+    (r0-or-r1 . ,riscv64:r0-or-r1)
+    (r0-r1 . ,riscv64:r0-r1)
+    (r0-xor-r1 . ,riscv64:r0-xor-r1)
+    (r0/r1 . ,riscv64:r0/r1)
+    (r0<<r1 . ,riscv64:r0<<r1)
+    (r0>>r1 . ,riscv64:r0>>r1)
+    (r1->r0 . ,riscv64:r1->r0)
+    (r2->r0 . ,riscv64:r2->r0)
+    (ret . ,riscv64:ret)
+    (return->r . ,riscv64:return->r)
+    (shl-r . ,riscv64:shl-r)
+    (swap-r-stack . ,riscv64:swap-r-stack)
+    (swap-r0-r1 . ,riscv64:swap-r0-r1)
+    (swap-r1-stack . ,riscv64:swap-r1-stack)
+    (test-r . ,riscv64:test-r)
+    (value->r . ,riscv64:value->r)
+    (value->r0 . ,riscv64:value->r0)
+    (word-mem->r . ,riscv64:word-mem->r)
+    (word-r . ,riscv64:word-r)
+    (word-r->local+n . ,riscv64:word-r->local+n)
+    (word-r0->r1-mem . ,riscv64:word-r0->r1-mem)
+    (word-r0-mem->r1-mem . ,riscv64:word-r0-mem->r1-mem)
+    (word-signed-r . ,riscv64:word-signed-r)
+    (xor-zf . ,riscv64:xor-zf)
+    (zf->r . ,riscv64:zf->r)
+    ))

module/mescc/riscv64/info.scm

@@ -0,0 +1,63 @@
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2018,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Initialize MesCC as riscv64 compiler
+
+;;; Code:
+
+(define-module (mescc riscv64 info)
+  #:use-module (mescc info)
+  #:use-module (mescc riscv64 as)
+  #:export (riscv64-info
+            riscv64:registers))
+
+(define (riscv64-info)
+  (make <info> #:types riscv64:type-alist #:registers riscv64:registers #:instructions riscv64:instructions))
+
+(define riscv64:registers '("t0" "t1" "t2" "t3" "t4")) ;;; t5+t6 is reserved
+(define riscv64:type-alist
+  `(("char" . ,(make-type 'signed 1 #f))
+    ("short" . ,(make-type 'signed 2 #f))
+    ("int" . ,(make-type 'signed 4 #f))
+    ("long" . ,(make-type 'signed 8 #f))
+    ("default" . ,(make-type 'signed 4 #f))
+    ("*" . ,(make-type 'unsigned 8 #f))
+    ("long long" . ,(make-type 'signed 8 #f))
+    ("long long int" . ,(make-type 'signed 8 #f))
+
+    ("void" . ,(make-type 'void 1 #f))
+    ("signed char" . ,(make-type 'signed 1 #f))
+    ("unsigned char" . ,(make-type 'unsigned 1 #f))
+    ("unsigned short" . ,(make-type 'unsigned 2 #f))
+    ("unsigned" . ,(make-type 'unsigned 4 #f))
+    ("unsigned int" . ,(make-type 'unsigned 4 #f))
+    ("unsigned long" . ,(make-type 'unsigned 8 #f))
+    ("unsigned long long" . ,(make-type 'unsigned 8 #f))
+    ("unsigned long long int" . ,(make-type 'unsigned 8 #f))
+
+    ("float" . ,(make-type 'float 4 #f))
+    ("double" . ,(make-type 'float 8 #f))
+    ("long double" . ,(make-type 'float 8 #f))
+
+    ("short int" . ,(make-type 'signed 2 #f))
+    ("unsigned short int" . ,(make-type 'unsigned 2 #f))
+    ("long int" . ,(make-type 'signed 8 #f))
+    ("unsigned long int" . ,(make-type 'unsigned 8 #f))))