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.
This commit is contained in:
W. J. van der Laan 2021-04-23 17:16:11 +00:00 committed by Janneke Nieuwenhuizen
parent 9044e13309
commit dc6af19506
7 changed files with 878 additions and 10 deletions

View File

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

View File

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

View File

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

View File

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

View File

@ -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")
"__arm__=1")
(append (cond ((equal? arch "arm")
'("__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)))

737
module/mescc/riscv64/as.scm Normal file
View File

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

View File

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