artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Initial x86_64 support.

Browse source 
make all-go && MES=guile ./pre-inst-env scripts/mescc -m64 -c scaffold/main.c
This commit is contained in:
Jan Nieuwenhuizen 2018-08-14 20:32:56 +02:00
parent ee9081f3ec
commit 3e1a197ed1
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
27 changed files with 702 additions and 103 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -37,10 +37,10 @@
*.x86-out *.x86-out
*.x86_64-mes-gcc-o *.x86_64-mes-gcc-o
*.x86_64-mes-gcc-out *.x86_64-mes-gcc-out
*.x86_64-mes-o
*.x86_64-mes-out *.x86_64-mes-out
*.x86_64-out *.x86_64-out
/src/*.h /src/*.h
/src/*.i /src/*.i
/src/mes /src/mes

2
build-aux/build-guile.sh
View file

@ -39,6 +39,8 @@ ${srcdest}module/mescc/bytevectors.scm
${srcdest}module/mescc/compile.scm ${srcdest}module/mescc/compile.scm
${srcdest}module/mescc/i386/as.scm ${srcdest}module/mescc/i386/as.scm
${srcdest}module/mescc/i386/info.scm ${srcdest}module/mescc/i386/info.scm
${srcdest}module/mescc/x86_64/as.scm
${srcdest}module/mescc/x86_64/info.scm
${srcdest}module/mescc/info.scm ${srcdest}module/mescc/info.scm
${srcdest}module/mescc/mescc.scm ${srcdest}module/mescc/mescc.scm
${srcdest}module/mescc/preprocess.scm ${srcdest}module/mescc/preprocess.scm

56
build-aux/build-x86_64-mes.sh
View file

@ -105,27 +105,28 @@ trace "TEST lib/x86_64-mes/exit-42.x86_64-out" echo lib/x86_64-mes/exit-42
# -o lib/x86_64-mes/libc+tcc.o # -o lib/x86_64-mes/libc+tcc.o
# fi # fi
# PREPROCESS=1
# if [ ! -d "$MES_SEED" ] \
# && [ "$ARCH" = "i386" \
# -o "$ARCH" = "i586" \
# -o "$ARCH" = "i686" ]; then
# MES_ARENA=100000000
# fi
# MES_ARENA=100000000 PREPROCESS=1
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crt0 if [ ! -d "$MES_SEED" ] \
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc-mini && [ "$ARCH" = "i386" \
-o "$ARCH" = "i586" \
-o "$ARCH" = "i686" ]; then
MES_ARENA=100000000
fi
# PREPROCESS= bash ${srcdest}build-aux/cc-mes.sh lib/x86_64-mes/exit-42 ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/linux/x86_64-mes/crt1
# trace "TEST exit-42.x86_64-mes-out" MES_LIBS='-l none' PREPROCESS= bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/x86_64-mes/exit-42
# { set +e; lib/x86_64-mes/exit-42.x86_64-mes-out; r=$?; set -e; }
# [ $r != 42 ] && echo " => $r" && exit 1
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crt1 trace "TEST lib/x86_64-mes/exit-42.x86_64-mes-out" echo lib/x86_64-mes/exit-42.x86_64-mes-out
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crti { set +e; lib/x86_64-mes/exit-42.x86_64-mes-out; r=$?; set -e; }
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crtn [ $r != 42 ] && echo " => $r" && exit 1
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc-mini
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/x86_64-mes/crt0
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/x86_64-mes/crti
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/x86_64-mes/crtn
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc # ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc
# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libgetopt # ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libgetopt
@ -147,13 +148,18 @@ trace "TEST lib/x86_64-mes/exit-42.x86_64-out" echo lib/x86_64-mes/exit-42
# echo MES_ARENA=$MES_ARENA # echo MES_ARENA=$MES_ARENA
# bash ${srcdest}build-aux/cc-mes.sh scaffold/main # bash ${srcdest}build-aux/cc-mes.sh scaffold/main
# bash ${srcdest}build-aux/cc-mes.sh scaffold/main MES_LIBS='-l none' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/main
# bash ${srcdest}build-aux/cc-mes.sh scaffold/hello
# bash ${srcdest}build-aux/cc-mes.sh scaffold/argv trace "TEST scaffold/main.x86_64-mes-out" echo scaffold/main.x86_64-mes-out
# bash ${srcdest}build-aux/cc-mes.sh scaffold/malloc { set +e; scaffold/main.x86_64-mes-out; r=$?; set -e; }
# ##sh ${srcdest}build-aux/cc-mes.sh scaffold/micro-mes [ $r != 42 ] && echo " => $r" && exit 1
# ##sh ${srcdest}build-aux/cc-mes.sh scaffold/tiny-mes
# # bash ${srcdest}build-aux/cc-mes.sh scaffold/mini-mes # MES_LIBS='-l mini' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/hello
# bash ${srcdest}build-aux/cc-mes.sh src/mes # MES_LIBS='-l mini' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/argv
# bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/malloc
# ##sh ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/micro-mes
# ##sh ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/tiny-mes
# # bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/mini-mes
# bash ${srcdest}build-aux/cc-x86_64-mes.sh src/mes
# cp src/mes.mes-out src/mes # cp src/mes.mes-out src/mes
true true

67
build-aux/cc-x86_64-mes.sh Executable file
View file

@ -0,0 +1,67 @@
#! /bin/sh
# 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/>.
set -e
. ${srcdest}build-aux/config.sh
. ${srcdest}build-aux/trace.sh
MESCC=${MESCC-$(command -v mescc)}
[ -z "$MESCC" ] && MESCC=scripts/mescc
MES=${MES-$(command -v mes)}
[ -z "$MES" ] && MES=src/mes
if [ "$V" = 2 ]; then
MES64_CFLAGS="$MES64_CFLAGS -v"
fi
c=$1
set -e
if [ -z "$ARCHDIR" ]; then
o="$c"
d=${c%%/*}
p="x86_64-mes-"
else
b=${c##*/}
d=${c%%/*}/x86_64-mes
o="$d/$b"
fi
mkdir -p $d
if [ -n "$PREPROCESS" ]; then
trace "CPP.mes64 $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -E -o "$o.E" "${srcdest}$c".c
trace "CC.mes64 $c.E" ./pre-inst-env bash $MESCC $MES64_CFLAGS -S "$o".E
trace "AS.mes64 $c.S" ./pre-inst-env bash $MESCC $MES64_CFLAGS -c -o "$o".${p}o "$o".S
if [ -z "$NOLINK" ]; then
trace "LD.mes64 $c.o" ./pre-inst-env bash $MESCC $MES64_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
fi
elif [ -n "$COMPILE" ]; then
trace "CC.mes64 $c.c" trace "MESCC $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -S -o "$o.S" "${srcdest}$c".c
trace "AS.mes64 $c.S" ./pre-inst-env bash $MESCC $MES64_CFLAGS -c -o "$o".${p}o "$o".S
if [ -z "$NOLINK" ]; then
trace "LD.mes64 $c.o" ./pre-inst-env bash $MESCC $MES64_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
fi
elif [ -z "$NOLINK" ]; then
trace "CC.mes64 $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -o "$o".${p}out "${srcdest}$c".c $MES_LIBS
else
trace "CC.mes64 $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -c -o "$o".${p}o "${srcdest}$c".c
fi

3
build-aux/config.sh
View file

@ -153,7 +153,8 @@ MES_CPPFLAGS=${MES_CPPFLAGS-"
MES_CFLAGS=${MES_CFLAGS-" MES_CFLAGS=${MES_CFLAGS-"
"} "}
MES_CFLAGS=${MES_CFLAGS-" MES64_CFLAGS=${MES64_CFLAGS-"
-m64
"} "}
M1FLAGS=${M1FLAGS-" M1FLAGS=${M1FLAGS-"

4
lib/linux/x86_64-mes-gcc/crt1.c
View file

@ -28,9 +28,9 @@ void
_start () _start ()
{ {
asm ( asm (
"movq %%rbp,%%rax\n\t" "mov %%rbp,%%rax\n\t"
"add $8,%%rax\n\t" "add $8,%%rax\n\t"
"movq (%%rax),%%rax\n\t" "mov (%%rax),%%rax\n\t"
"add $3,%%rax\n\t" "add $3,%%rax\n\t"
"shl $3,%%rax\n\t" "shl $3,%%rax\n\t"
"add %%rbp,%%rax\n\t" "add %%rbp,%%rax\n\t"

BIN
lib/linux/x86_64-mes/crt1 Normal file
View file

Binary file not shown.

58
lib/linux/x86_64-mes/crt1.c Normal file
View file

@ -0,0 +1,58 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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/>.
*/
char **environ = 0;
int main (int argc, char *argv[]);
int
_start ()
{
asm ("mov____%rbp,%rax");
asm ("add____$i8,%rax !8");
asm ("mov____(%rax),%rax");
asm ("add____$i8,%rax !0x03");
asm ("shl____$i8,%rax !0x03");
asm ("add____%rbp,%rax");
// 40017a: 48 a3 88 77 66 55 44 movabs %rax,0x1122334455667788
// 48 89 05 bd 0e 20 00 mov %rax,0x200ebd(%rip) # 601000 <_GLOBAL_OFFSET_TABLE_>
// FIXME: 64-bit addresses...DUNNO!
// asm ("mov____%rax,0x32 &environ");
asm ("mov____%rbp,%rax");
asm ("add____$i8,%rax !16");
asm ("mov____%rax,%rsi");
asm ("mov____%rbp,%rax");
asm ("add____$i8,%rax !8");
asm ("mov____(%rax),%rax");
asm ("mov____%rax,%rdi");
main ();
// FIXME
//asm ("call32 &main !00 !00 !00 !00");
asm ("mov____%rax,%rdi");
asm ("mov____$i32,%rax %0x3c");
asm ("syscall");
asm ("hlt");
}

8
lib/x86-mes/x86.M1
View file

@ -186,13 +186,13 @@ DEFINE setne__%al 0f95c0
DEFINE shl____$i8,%eax c1e0 DEFINE shl____$i8,%eax c1e0
DEFINE shl____%cl,%eax d3e0 DEFINE shl____%cl,%eax d3e0
DEFINE shr____%cl,%eax d3e8 DEFINE shr____%cl,%eax d3e8
DEFINE sub____$8,%esp 83ec
DEFINE sub____$i32,%esp 81ec
DEFINE sub____%al,%dl 28d0 DEFINE sub____%al,%dl 28d0
DEFINE sub____%dl,%al 28c2 DEFINE sub____%dl,%al 28c2
DEFINE sub____%eax,%edx 29c2 DEFINE sub____%eax,%edx 29c2
DEFINE sub____%edx,%eax 29d0 DEFINE sub____%edx,%eax 29d0
DEFINE sub____%edx,%eax 29d0 DEFINE sub____%edx,%eax 29d0
DEFINE sub____%esp,$i32 81ec
DEFINE sub____%esp,$i8 83ec
DEFINE test___%al,%al 84c0 DEFINE test___%al,%al 84c0
DEFINE test___%eax,%eax 85c0 DEFINE test___%eax,%eax 85c0
DEFINE xchg___%eax,(%esp) 870424 DEFINE xchg___%eax,(%esp) 870424
@ -204,6 +204,10 @@ DEFINE xor____%ecx,%ecx 31c9
DEFINE xor____%edx,%eax 31d0 DEFINE xor____%edx,%eax 31d0
DEFINE xor____%edx,%edx 31d2 DEFINE xor____%edx,%edx 31d2
# deprecated, remove after 0.18
DEFINE sub____%esp,$i32 81ec
DEFINE sub____%esp,$i8 83ec
DEFINE SYS_exit 01000000 DEFINE SYS_exit 01000000
DEFINE SYS_fork 02000000 DEFINE SYS_fork 02000000
DEFINE SYS_read 03000000 DEFINE SYS_read 03000000

2
lib/x86_64-mes/elf64-footer-single-main.hex2
View file

@ -34,7 +34,7 @@
00 00 00 00 00 00
# @240 # @370
:ELF_sym :ELF_sym
00 00 00 00 # st-name 00 00 00 00 # st-name
00 # st-info = stt-func= 2 00 # st-info = stt-func= 2

11
lib/x86_64-mes/elf64-header.hex2
View file

@ -36,10 +36,12 @@
00 00 00 00 00 00 00 # e_ident[EI_PAD] 00 00 00 00 00 00 00 # e_ident[EI_PAD]
# 0x10
02 00 # e_type Indicating Executable 02 00 # e_type Indicating Executable
3e 00 # e_machine Indicating AMD64 3e 00 # e_machine Indicating AMD64
01 00 00 00 # e_version Indicating original elf 01 00 00 00 # e_version Indicating original elf
# 0x18
&ELF_text 00 00 00 00 # e_entry Address of the entry point &ELF_text 00 00 00 00 # e_entry Address of the entry point
%ELF_program_headers>ELF_base # e_phoff Address of program header table %ELF_program_headers>ELF_base # e_phoff Address of program header table
00 00 00 00 00 00 00 00
@ -126,7 +128,7 @@
00 00 00 00 00 00 00 00 # sh_length 00 00 00 00 00 00 00 00 # sh_length
00 00 00 00 # sh_link 00 00 00 00 # sh_link
00 00 00 00 # sh_info 00 00 00 00 # sh_info
01 00 00 00 00 00 00 00 # sh_1? 00 00 00 00 00 00 00 00 # sh_1?
00 00 00 00 00 00 00 00 # sh_entsize 00 00 00 00 00 00 00 00 # sh_entsize
## FIXME: M0 for calculations? ## FIXME: M0 for calculations?
@ -180,9 +182,6 @@
:ELF_section_header_sym :ELF_section_header_sym
%ELF_shstr__sym>ELF_shstr # sh_name %ELF_shstr__sym>ELF_shstr # sh_name
## FIXME: using type 03 (strtab) makes objdump -d happier
## using type 02 make readelf complain but display valid symbol table
# 03 00 00 00 # sh_type: str-sht-symtab
02 00 00 00 # sh_type: str-sht-symtab 02 00 00 00 # sh_type: str-sht-symtab
00 00 00 00 00 00 00 00 # sh_flags 00 00 00 00 00 00 00 00 # sh_flags
&ELF_sym 00 00 00 00 # sh_addr &ELF_sym 00 00 00 00 # sh_addr
@ -190,8 +189,8 @@
%ELF_end>ELF_sym 00 00 00 00 # sh_length %ELF_end>ELF_sym 00 00 00 00 # sh_length
06 00 00 00 # sh_link:6 06 00 00 00 # sh_link:6
00 00 00 00 # sh_info 00 00 00 00 # sh_info
00 00 00 00 00 00 00 00 # sh_1? 01 00 00 00 00 00 00 00 # sh_1?
40 00 00 00 00 00 00 00 # sh_entsize 18 00 00 00 00 00 00 00 # sh_entsize
:ELF_section_header_str :ELF_section_header_str
%ELF_shstr__str>ELF_shstr # sh_name %ELF_shstr__str>ELF_shstr # sh_name

50
lib/x86_64-mes/x86_64.M1 Normal file
View file

@ -0,0 +1,50 @@
### GNU Mes --- Maxwell Equations of Software
### Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
###
### This file is part of GNU Mes.
###
### 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/>.
DEFINE add____$i8,%rax 4883c0
DEFINE add____%rbp,%rax 4801e8
DEFINE call32 e8
DEFINE hlt f4
DEFINE mov____$i32,%rax 48c7c0
DEFINE mov____$i32,0x8(%rbp) c745
DEFINE mov____$i64,%rax 48a1
DEFINE mov____%edi,0x8(%rbp) 897d
DEFINE mov____%r8,0x8(%rbp) 4c8945
DEFINE mov____%rax,%rax 4889c0
DEFINE mov____%rax,%rbx 4889c3
DEFINE mov____%rax,%rdi 4889c7
DEFINE mov____%rax,%rsi 4889c6
DEFINE mov____%rax,0x8(%rbp) 488945
DEFINE mov____%rbp,%rax 4889e8
DEFINE mov____%rbp,%rsp 4889ec
DEFINE mov____%rcx,0x8(%rbp) 48894d
DEFINE mov____%rdi,0x8(%rbp) 48897d
DEFINE mov____%rdx,0x8(%rbp) 488955
DEFINE mov____%rsi,0x8(%rbp) 488975
DEFINE mov____%rsp,%rbp 4889e5
DEFINE mov____(%rax),%rax 488b00
DEFINE mov____0x8(%rbp),%eax 8b45
DEFINE mov____0x8(%rbp),%rax 488b45
DEFINE nop 90
DEFINE pop____%rbp 5d
DEFINE push___%rbp 55
DEFINE ret c3
DEFINE shl____$i8,%rax 48c1e0
DEFINE sub____$i32,%rsp 4881ec
DEFINE syscall 0f05
DEFINE test___%rax,%rax 4885c0

1
mes/module/mescc/i386/as.mes
View file

@ -19,4 +19,5 @@
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(mes-use-module (mescc as)) (mes-use-module (mescc as))
(mes-use-module (mescc info))
(include-from-path "mescc/i386/as.scm") (include-from-path "mescc/i386/as.scm")

23
mes/module/mescc/i386/info.mes Normal file
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 i386 as))
(include-from-path "mescc/i386/info.scm")

4
mes/module/mescc/mescc.mes
View file

@ -23,8 +23,10 @@
(mes-use-module (srfi srfi-26)) (mes-use-module (srfi srfi-26))
(mes-use-module (mes misc)) (mes-use-module (mes misc))
(mes-use-module (mes getopt-long)) (mes-use-module (mes getopt-long))
(mes-use-module (mes guile)) (mes-use-module (mes guile))
(mes-use-module (mescc i386 info))
(mes-use-module (mescc x86_64 info))
(mes-use-module (mescc preprocess)) (mes-use-module (mescc preprocess))
(mes-use-module (mescc compile)) (mes-use-module (mescc compile))
(mes-use-module (mescc M1)) (mes-use-module (mescc M1))

23
mes/module/mescc/x86_64/as.mes Normal file
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 as))
(mes-use-module (mescc info))
(include-from-path "mescc/x86_64/as.scm")

23
mes/module/mescc/x86_64/info.mes Normal file
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 x86_64 as))
(include-from-path "mescc/x86_64/info.scm")

8
module/mescc/as.scm
View file

@ -20,7 +20,9 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (mes guile) #:use-module (mes guile)
#:use-module (mescc bytevectors) #:use-module (mescc bytevectors)
#:export (dec->hex #:use-module (mescc info)
#:export (as
dec->hex
int->bv8 int->bv8
int->bv16 int->bv16
int->bv32)) int->bv32))
@ -44,3 +46,7 @@
(cond ((number? o) (number->string o 16)) (cond ((number? o) (number->string o 16))
((char? o) (number->string (char->integer o) 16)) ((char? o) (number->string (char->integer o) 16))
(else (format #f "~s" o)))) (else (format #f "~s" o))))
(define (as info instruction . rest)
(let ((proc (assoc-ref (.instructions info) instruction)))
(apply proc info rest)))

151
module/mescc/compile.scm
View file

@ -551,6 +551,32 @@
(define (number->accu o) (define (number->accu o)
(wrap-as (i386:value->accu o))) (wrap-as (i386:value->accu o)))
(define (ident->r0 info)
(lambda (o)
(cond ((assoc-ref (.locals info) o) => (cut local->r0 info <>))
((assoc-ref (.statics info) o) => global->accu)
((assoc-ref (filter (negate static-global?) (.globals info)) o) => global->accu)
((assoc-ref (.constants info) o) => number->accu)
(else (list (i386:label->accu `(#:address ,o))))
;; ((assoc-ref (.statics info) o) => (cut global->r0 info <>))
;; ((assoc-ref (filter (negate static-global?) (.globals info)) o) => (cut global->r0 info <>))
;; ((assoc-ref (.constants info) o) => (cut number->r0 info <>))
;; (else (wrap-as (as info 'label->r0 `(#:address ,o))))
)))
(define (local->r0 info o)
(let* ((type (local:type o)))
(cond ((or (c-array? type)
(structured-type? type))
;;(wrap-as (as info 'local-ptr->r0 (local:id o)))
(wrap-as (i386:local-ptr->accu (local:id o)))
)
(else (append (wrap-as (as info 'local->r0 (local:id o)))
(convert-r0 info type))))))
(define (ident-address->accu info) (define (ident-address->accu info)
(lambda (o) (lambda (o)
(cond ((assoc-ref (.locals info) o) (cond ((assoc-ref (.locals info) o)
@ -602,6 +628,26 @@
(if (<= size 4) (wrap-as (i386:accu->label global)) (if (<= size 4) (wrap-as (i386:accu->label global))
(wrap-as (i386:accu*n->label global size))))))))) (wrap-as (i386:accu*n->label global size)))))))))
(define (r0->ident info)
(lambda (o)
(cond ((assoc-ref (.locals info) o)
=>
(lambda (local) (let ((size (->size local)))
(if (<= size 4) (wrap-as (as info 'r0->local (local:id local)))
(wrap-as (i386:accu*n->local (local:id local) size))
;;(wrap-as (as info 'r0*n->local (local:id local) size))
))))
((assoc-ref (.statics info) o)
=>
(lambda (global) (let ((size (->size global)))
(if (<= size 4) (wrap-as (i386:accu->label global))
(wrap-as (i386:accu*n->label global size))))))
((assoc-ref (filter (negate static-global?) (.globals info)) o)
=>
(lambda (global) (let ((size (->size global)))
(if (<= size 4) (wrap-as (i386:accu->label global))
(wrap-as (i386:accu*n->label global size)))))))))
(define (value->ident info) (define (value->ident info)
(lambda (o value) (lambda (o value)
(cond ((assoc-ref (.locals info) o) (cond ((assoc-ref (.locals info) o)
@ -706,13 +752,50 @@
(define (alloc-register info) (define (alloc-register info)
(let ((registers (.registers info))) (let ((registers (.registers info)))
(stderr " =>register: ~a\n" (car registers)) ;; (stderr "\nalloc-register")
(clone info #:allocated (cons (car registers) (.allocated info)) #:registers (cdr registers)))) ;; (stderr " allocated: ~s\n" (.allocated info))
;; (stderr " =>registers: ~s\n" registers)
;; (stderr " =>register: ~s\n" (car registers))
;; (clone info #:allocated (cons (car registers) (.allocated info)) #:registers (cdr registers))
info
))
(define (free-register info) (define (free-register info)
(let ((allocated (.allocated info))) (let ((allocated (.allocated info)))
(stderr " <=register: ~a\n" (car allocated)) ;; (stderr " <=register: ~a\n" (car allocated))
(clone info #:allocated (cdr allocated) #:registers (cons (car allocated) (.registers info))))) ;; (clone info #:allocated (cdr allocated) #:registers (cons (car allocated) (.registers info)))
info
))
(define (r0->r1-mem*n- info n)
(wrap-as
(case n
((1) (as info 'byte-r0->r1-mem))
((2) (as info 'word-r0->r1-mem))
((4) (as info 'int-r0->r1-mem))
((8) (as info 'quad-r0->r1-mem))
(else (append (let loop ((i 0))
(if (>= i n) '()
(append (if (= i 0) '()
(append (i386:accu+value 4)
(i386:base+value 4)))
(case (- n i)
((1) (append (i386:accu+value -3)
(i386:base+value -3)
(i386:accu-mem->base-mem)))
((2) (append (i386:accu+value -2)
(i386:base+value -2)
(i386:accu-mem->base-mem)))
((3) (append (i386:accu+value -1)
(i386:base+value -1)
(i386:accu-mem->base-mem)))
(else (i386:accu-mem->base-mem)))
(loop (+ i 4))))))))))
(define (r0->r1-mem*n info n)
;;(append-text info (r0->r1-mem*n- info n))
(append-text info (accu->base-mem*n- info n))
)
(define (expr->register* o info) (define (expr->register* o info)
@ -852,7 +935,7 @@
info))) info)))
(define (expr->register o info) (define (expr->register o info)
(stderr "expr->register o=~s\n" o) ;;(stderr "expr->register o=~s\n" o)
(let ((locals (.locals info)) (let ((locals (.locals info))
(text (.text info)) (text (.text info))
@ -882,7 +965,7 @@
((p-expr (fixed ,value)) ((p-expr (fixed ,value))
(let ((value (cstring->int value)) (let ((value (cstring->int value))
(info (alloc-register info))) (info (alloc-register info)))
(append-text info (wrap-as (i386:value->accu value))))) (append-text info (wrap-as (as info 'value->r0 value)))))
((p-expr (float ,value)) ((p-expr (float ,value))
(let ((value (cstring->float value))) (let ((value (cstring->float value)))
@ -899,7 +982,7 @@
(,char (guard (char? char)) (append-text info (wrap-as (i386:value->accu char)))) (,char (guard (char? char)) (append-text info (wrap-as (i386:value->accu char))))
((p-expr (ident ,name)) ((p-expr (ident ,name))
(append-text info ((ident->accu info) name))) (append-text info ((ident->r0 info) name)))
((initzer ,initzer) ((initzer ,initzer)
(expr->register initzer info)) (expr->register initzer info))
@ -973,7 +1056,7 @@
(not (assoc name globals)) (not (assoc name globals))
(not (equal? name (.function info)))) (not (equal? name (.function info))))
(stderr "warning: undeclared function: ~a\n" name)) (stderr "warning: undeclared function: ~a\n" name))
(append-text args-info (list (i386:call-label name n)))) (append-text args-info (wrap-as (as info 'call-label name n))))
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu (expr->register `(p-expr (ident ,name)) empty))) (accu (expr->register `(p-expr (ident ,name)) empty)))
(append-text args-info (append (.text accu) (append-text args-info (append (.text accu)
@ -1206,7 +1289,6 @@
(append-text info ((ident-add info) name (- size))))) (append-text info ((ident-add info) name (- size)))))
((assn-expr ,a (op ,op) ,b) ((assn-expr ,a (op ,op) ,b)
(stderr "ASSN!\n")
(let* ((info (append-text info (ast->comment o))) (let* ((info (append-text info (ast->comment o)))
(type (ast->type a info)) (type (ast->type a info))
(rank (->rank type)) (rank (->rank type))
@ -1252,14 +1334,13 @@
(or (= size-b 1) (= size-b 2))))) (or (= size-b 1) (= size-b 2)))))
(stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o)))) (stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
(stderr " size[~a]:~a != size[~a]:~a\n" rank size rank-b size-b)) (stderr " size[~a]:~a != size[~a]:~a\n" rank size rank-b size-b))
(stderr " assign a=~s\n" a)
(pmatch a (pmatch a
((p-expr (ident ,name)) ((p-expr (ident ,name))
(if (or (<= size 4) ;; FIXME: long long = int (if (or (<= size 4) ;; FIXME: long long = int
(<= size-b 4)) (append-text info ((accu->ident info) name)) (<= size-b 4)) (append-text info ((r0->ident info) name))
(let* ((info (expr->base* a info)) (let* (;;(info (expr->register* a info))
(info (accu->base-mem*n info size))) (info (expr->base* a info))
;;??? (info (r0->r1-mem*n info size)))
(free-register info)))) (free-register info))))
(_ (let* ((info (expr->base* a info)) (_ (let* ((info (expr->base* a info))
(info (if (not (bit-field? type)) info (info (if (not (bit-field? type)) info
@ -1312,6 +1393,20 @@
(wrap-as (i386:word-accu))) (wrap-as (i386:word-accu)))
(else '()))))) (else '())))))
(define (convert-r0 info type)
(if (not (type? type)) '()
(let ((sign (signed? type))
(size (->size type)))
(cond ((and (= size 1) sign)
(wrap-as (i386:signed-byte-accu)))
((= size 1)
(wrap-as (i386:byte-accu)))
((and (= size 2) sign)
(wrap-as (i386:signed-word-accu)))
((= size 1)
(wrap-as (i386:word-accu)))
(else '())))))
(define (expr->base o info) (define (expr->base o info)
(let* ((info (append-text info (wrap-as (i386:push-accu)))) (let* ((info (append-text info (wrap-as (i386:push-accu))))
(info (expr->register o info)) (info (expr->register o info))
@ -1384,21 +1479,21 @@
4))) 4)))
((jump (if (= size 1) i386:jump-byte-z ((jump (if (= size 1) i386:jump-byte-z
i386:jump-z) i386:jump-z)
(wrap-as (i386:accu-zero?))) o))) (wrap-as (as info 'r0-zero?))) o)))
((de-ref ,expr) (let* ((rank (expr->rank info expr)) ((de-ref ,expr) (let* ((rank (expr->rank info expr))
(size (if (= rank 1) (ast-type->size info expr) (size (if (= rank 1) (ast-type->size info expr)
4))) 4)))
((jump (if (= size 1) i386:jump-byte-z ((jump (if (= size 1) i386:jump-byte-z
i386:jump-z) i386:jump-z)
(wrap-as (i386:accu-zero?))) o))) (wrap-as (as info 'r0-zero?))) o)))
((assn-expr (p-expr (ident ,name)) ,op ,expr) ((assn-expr (p-expr (ident ,name)) ,op ,expr)
((jump i386:jump-z ((jump i386:jump-z
(append ((ident->accu info) name) (append ((ident->accu info) name)
(wrap-as (i386:accu-zero?)))) o)) (wrap-as (as info 'r0-zero?)))) o))
(_ ((jump i386:jump-z (wrap-as (i386:accu-zero?))) o))))) (_ ((jump i386:jump-z (wrap-as (as info 'r0-zero?))) o)))))
(define (cstring->int o) (define (cstring->int o)
(let ((o (cond ((string-suffix? "ULL" o) (string-drop-right o 3)) (let ((o (cond ((string-suffix? "ULL" o) (string-drop-right o 3))
@ -1523,7 +1618,7 @@
(_ (error "ptr-declr->rank not supported: " o)))) (_ (error "ptr-declr->rank not supported: " o))))
(define (ast->info o info) (define (ast->info o info)
(stderr "ast->info o=~s\n" o) ;; (stderr "ast->info o=~s\n" o)
(let ((functions (.functions info)) (let ((functions (.functions info))
(globals (.globals info)) (globals (.globals info))
(locals (.locals info)) (locals (.locals info))
@ -1563,7 +1658,7 @@
(append-text info (wrap-as (asm->m1 arg0)))) (append-text info (wrap-as (asm->m1 arg0))))
(let* ((info (append-text info (ast->comment o))) (let* ((info (append-text info (ast->comment o)))
(info (expr->register `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) info))) (info (expr->register `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) info)))
(append-text info (wrap-as (i386:accu-zero?)))))) (append-text info (wrap-as (as info 'r0-zero?))))))
((if ,test ,then) ((if ,test ,then)
(let* ((info (append-text info (ast->comment `(if ,test (ellipsis))))) (let* ((info (append-text info (ast->comment `(if ,test (ellipsis)))))
@ -1719,7 +1814,7 @@
((return ,expr) ((return ,expr)
(let ((info (expr->register expr info))) (let ((info (expr->register expr info)))
(append-text info (append (wrap-as (i386:ret)))))) (append-text info (append (wrap-as (as info 'ret))))))
((decl . ,decl) ((decl . ,decl)
;;FIXME: ridiculous performance hit with mes ;;FIXME: ridiculous performance hit with mes
@ -1740,13 +1835,13 @@
;; EXPR ;; EXPR
((expr-stmt ,expression) ((expr-stmt ,expression)
(let* ((info (expr->register expression info)) (let* ((info (expr->register expression info))
(info (append-text info (wrap-as (i386:accu-zero?))))) (info (append-text info (wrap-as (as info 'r0-zero?)))))
(free-register info))) (free-register info)))
;; FIXME: why do we get (post-inc ...) here ;; FIXME: why do we get (post-inc ...) here
;; (array-ref ;; (array-ref
(_ (let ((info (expr->register o info))) (_ (let ((info (expr->register o info)))
(append-text info (wrap-as (i386:accu-zero?)))))))) (append-text info (wrap-as (as info 'r0-zero?))))))))
(define (ast-list->info o info) (define (ast-list->info o info)
(fold ast->info info o)) (fold ast->info info o))
@ -2344,13 +2439,13 @@
'() '()
)) ))
(define (param-list->text o) (define (param-list->text o info)
(pmatch o (pmatch o
((param-list . ,formals) ((param-list . ,formals)
(let ((n (length formals))) (let ((n (length formals)))
(wrap-as (append (i386:function-preamble) (wrap-as (append (as info 'function-preamble formals)
(append-map (formal->text n) formals (iota n)) (append-map (formal->text n) formals (iota n))
(i386:function-locals))))) (as info 'function-locals)))))
(_ (error "param-list->text: not supported: " o)))) (_ (error "param-list->text: not supported: " o))))
(define (param-list->locals o info) (define (param-list->locals o info)
@ -2395,14 +2490,14 @@
(define (fctn-defn->info o info) (define (fctn-defn->info o info)
(define (assert-return text) (define (assert-return text)
(let ((return (wrap-as (i386:ret)))) (let ((return (wrap-as (as info 'ret))))
(if (equal? (list-tail text (- (length text) (length return))) return) text (if (equal? (list-tail text (- (length text) (length return))) return) text
(append text return)))) (append text return))))
(let ((name (fctn-defn:get-name o))) (let ((name (fctn-defn:get-name o)))
(mescc:trace name) (mescc:trace name)
(let* ((type (fctn-defn:get-type info o)) (let* ((type (fctn-defn:get-type info o))
(formals (fctn-defn:get-formals o)) (formals (fctn-defn:get-formals o))
(text (param-list->text formals)) (text (param-list->text formals info))
(locals (param-list->locals formals info)) (locals (param-list->locals formals info))
(statement (fctn-defn:get-statement o)) (statement (fctn-defn:get-statement o))
(function (cons name (make-function name type '()))) (function (cons name (make-function name type '())))

60
module/mescc/i386/as.scm
View file

@ -25,6 +25,7 @@
(define-module (mescc i386 as) (define-module (mescc i386 as)
#:use-module (mes guile) #:use-module (mes guile)
#:use-module (mescc as) #:use-module (mescc as)
#:use-module (mescc info)
#:export ( #:export (
i386:accu%base i386:accu%base
i386:accu*base i386:accu*base
@ -86,8 +87,6 @@
i386:call-accu i386:call-accu
i386:call-label i386:call-label
i386:formal i386:formal
i386:function-locals
i386:function-preamble
i386:jump i386:jump
i386:jump i386:jump
i386:jump-a i386:jump-a
@ -134,7 +133,6 @@
i386:push-local i386:push-local
i386:push-local-address i386:push-local-address
i386:push-local-de-ref i386:push-local-de-ref
i386:ret
i386:ret-local i386:ret-local
i386:sub-base i386:sub-base
i386:test-base i386:test-base
@ -159,17 +157,19 @@
i386:signed-byte-accu i386:signed-byte-accu
i386:word-accu i386:word-accu
i386:signed-word-accu i386:signed-word-accu
i386:instructions
)) ))
(define (i386:nop) (define (i386:nop)
'(("nop"))) '(("nop")))
(define (i386:function-preamble) (define (i386:function-preamble . rest)
'(("push___%ebp") '(("push___%ebp")
("mov____%esp,%ebp"))) ("mov____%esp,%ebp")))
(define (i386:function-locals) (define (i386:function-locals . rest)
`(("sub____%esp,$i32" (#:immediate ,(+ (* 4 1025) (* 20 4)))))) ; sub %esp,xxx 4*1024 buf, 20 local vars `(("sub____$i32,%esp" (#:immediate ,(+ (* 4 1025) (* 20 4)))))) ; 4*1024 buf, 20 local vars
(define (i386:push-label label) (define (i386:push-label label)
`(("push___$i32" (#:address ,label)))) ; push $0x<label> `(("push___$i32" (#:address ,label)))) ; push $0x<label>
@ -330,9 +330,9 @@
(define (i386:push-base) (define (i386:push-base)
'(("push___%edx"))) ; push %edx '(("push___%edx"))) ; push %edx
(define (i386:ret) (define (i386:ret . rest)
'(("leave") ; leave '(("leave")
("ret"))) ; ret ("ret")))
(define (i386:accu->base) (define (i386:accu->base)
'(("mov____%eax,%edx"))) ; mov %eax,%edx '(("mov____%eax,%edx"))) ; mov %eax,%edx
@ -503,7 +503,7 @@
(define (i386:value->accu v) (define (i386:value->accu v)
(or v (error "invalid value: i386:value->accu: " v)) (or v (error "invalid value: i386:value->accu: " v))
`(("mov____$i32,%eax" (#:immediate ,v)))) ; mov $<v>,%eax `(("mov____$i32,%eax" (#:immediate ,v))))
(define (i386:value->accu-mem v) (define (i386:value->accu-mem v)
`(("mov____$i32,(%eax)" (#:immediate ,v)))) ; movl $0x<v>,(%eax) `(("mov____$i32,(%eax)" (#:immediate ,v)))) ; movl $0x<v>,(%eax)
@ -545,7 +545,7 @@
`(("mov____$i32,0x32" (#:address ,label) `(("mov____$i32,0x32" (#:address ,label)
(#:immediate ,v)))) (#:immediate ,v))))
(define (i386:call-label label n) (define (i386:call-label info label n)
`((call32 (#:offset ,label)) `((call32 (#:offset ,label))
("add____$i8,%esp" (#:immediate1 ,(* n 4))))) ("add____$i8,%esp" (#:immediate1 ,(* n 4)))))
@ -689,3 +689,41 @@
(define (i386:signed-word-accu) (define (i386:signed-word-accu)
'(("movswl_%ax,%eax"))) '(("movswl_%ax,%eax")))
;;;;;;;;;;;;
(define (i386:r0->local info n)
(or n (error "invalid value: i386:r0->local: " n))
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
(n (- 0 (* 4 n))))
`(,(if (< (abs n) #x80) `(,(string-append "mov____%" r0 ",0x8(%ebp)") (#:immediate1 ,n))
`(,(string-append "mov____%" r0 ",0x32(%ebp)") (#:immediate ,n))))))
(define (i386:value->r0 info v)
(or v (error "invalid value: i386:value->r0: " v))
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
`((,(string-append "mov____$i32,%" r0) (#:immediate ,v)))))
(define (i386:r0-zero? info)
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
`((,(string-append "test___%" r0 "," "%" r0)))))
(define (i386:local->r0 info n)
(or n (error "invalid value: i386:local->r0: " n))
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
(n (- 0 (* 4 n))))
`(,(if (< (abs n) #x80) `(,(string-append "mov____0x8(%ebp),%" r0) (#:immediate1 ,n))
`(,(string-append "mov____0x32(%ebp),%" r0) (#:immediate ,n))))))
(define i386:instructions
`(
(call-label . ,i386:call-label)
(function-preamble . ,i386:function-preamble)
(function-locals . ,i386:function-locals)
(local->r0 . ,i386:local->r0)
(r0->local . ,i386:r0->local)
(r0-zero? . ,i386:r0-zero?)
(ret . ,i386:ret)
(value->r0 . ,i386:value->r0)
))

3
module/mescc/i386/info.scm
View file

@ -24,10 +24,11 @@
(define-module (mescc i386 info) (define-module (mescc i386 info)
#:use-module (mescc info) #:use-module (mescc info)
#:use-module (mescc i386 as)
#:export (x86-info)) #:export (x86-info))
(define (x86-info) (define (x86-info)
(make <info> #:types i386:type-alist #:registers i386:registers)) (make <info> #:types i386:type-alist #:registers i386:registers #:instructions i386:instructions))
;; FIXME: use abstract, unlimited R0...RN and make concrete in second pass? ;; FIXME: use abstract, unlimited R0...RN and make concrete in second pass?
(define i386:registers '("eax" "ebx" "ecx" "edx" "esi")) (define i386:registers '("eax" "ebx" "ecx" "edx" "esi"))

18
module/mescc/info.scm
View file

@ -46,6 +46,7 @@
.continue .continue
.allocated .allocated
.registers .registers
.instructions
<type> <type>
make-type make-type
@ -117,7 +118,7 @@
structured-type?)) structured-type?))
(define-immutable-record-type <info> (define-immutable-record-type <info>
(make-<info> types constants functions globals locals statics function text post break continue allocated registers) (make-<info> types constants functions globals locals statics function text post break continue allocated registers instructions)
info? info?
(types .types) (types .types)
(constants .constants) (constants .constants)
@ -130,12 +131,13 @@
(post .post) (post .post)
(break .break) (break .break)
(continue .continue) (continue .continue)
(allocated .allocated)
(registers .registers) (registers .registers)
(allocated .allocated)) (instructions .instructions))
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()) (allocated '()) (registers '())) (define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()) (allocated '()) (registers '()) (instructions '()))
(cond ((eq? o <info>) (cond ((eq? o <info>)
(make-<info> types constants functions globals locals statics function text post break continue allocated registers)))) (make-<info> types constants functions globals locals statics function text post break continue allocated registers instructions))))
(define (clone o . rest) (define (clone o . rest)
(cond ((info? o) (cond ((info? o)
@ -151,7 +153,8 @@
(break (.break o)) (break (.break o))
(continue (.continue o)) (continue (.continue o))
(allocated (.allocated o)) (allocated (.allocated o))
(registers (.registers o))) (registers (.registers o))
(instructions (.instructions o)))
(let-keywords rest (let-keywords rest
#f #f
((types types) ((types types)
@ -166,8 +169,9 @@
(break break) (break break)
(continue continue) (continue continue)
(allocated allocated) (allocated allocated)
(registers registers)) (registers registers)
(make <info> #:types types #:constants constants #:functions functions #:globals globals #:locals locals #:statics statics #:function function #:text text #:post post #:break break #:continue continue #:allocated allocated #:registers registers)))))) (instructions instructions))
(make <info> #:types types #:constants constants #:functions functions #:globals globals #:locals locals #:statics statics #:function function #:text text #:post post #:break break #:continue continue #:allocated allocated #:registers registers #:instructions instructions))))))
;; ("int" . ,(make-type 'builtin 4 #f 0 #f)) ;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
;; (make-type 'enum 4 0 fields) ;; (make-type 'enum 4 0 fields)

63
module/mescc/mescc.scm
View file

@ -25,6 +25,7 @@
#:use-module (mes misc) #:use-module (mes misc)
#:use-module (mescc i386 info) #:use-module (mescc i386 info)
#:use-module (mescc x86_64 info)
#:use-module (mescc preprocess) #:use-module (mescc preprocess)
#:use-module (mescc compile) #:use-module (mescc compile)
#:use-module (mescc M1) #:use-module (mescc M1)
@ -33,8 +34,6 @@
mescc:assemble mescc:assemble
mescc:link)) mescc:link))
(define %info (x86-info))
(define GUILE-with-output-to-file with-output-to-file) (define GUILE-with-output-to-file with-output-to-file)
(define (with-output-to-file file-name thunk) (define (with-output-to-file file-name thunk)
(if (equal? file-name "-") (thunk) (if (equal? file-name "-") (thunk)
@ -52,7 +51,10 @@
(defines (reverse (filter-map (multi-opt 'define) options))) (defines (reverse (filter-map (multi-opt 'define) options)))
(includes (reverse (filter-map (multi-opt 'include) options))) (includes (reverse (filter-map (multi-opt 'include) options)))
(includes (cons dir includes)) (includes (cons dir includes))
(prefix (option-ref options 'prefix ""))) (prefix (option-ref options 'prefix ""))
(machine (option-ref options 'machine "32"))
(arch (if (equal? machine "32") "__i386__=1" "__x86_64__=1"))
(defines (cons arch defines)))
(with-output-to-file ast-file-name (with-output-to-file ast-file-name
(lambda _ (for-each (cut c->ast prefix defines includes write <>) files))))) (lambda _ (for-each (cut c->ast prefix defines includes write <>) files)))))
@ -83,13 +85,19 @@
(includes (reverse (filter-map (multi-opt 'include) options))) (includes (reverse (filter-map (multi-opt 'include) options)))
(dir (dirname file-name)) (dir (dirname file-name))
(includes (cons dir includes)) (includes (cons dir includes))
(prefix (option-ref options 'prefix ""))) (prefix (option-ref options 'prefix ""))
(machine (option-ref options 'machine "32"))
(info (if (equal? machine "32") (x86-info) (x86_64-info)))
(arch (if (equal? machine "32") "__i386__=1" "__x86_64__=1"))
(defines (cons arch defines)))
(with-input-from-file file-name (with-input-from-file file-name
(cut c99-input->info %info #:prefix prefix #:defines defines #:includes includes)))) (cut c99-input->info info #:prefix prefix #:defines defines #:includes includes))))
(define (E->info options file-name) (define (E->info options file-name)
(let ((ast (with-input-from-file file-name read))) (let* ((ast (with-input-from-file file-name read))
(c99-ast->info %info ast))) (machine (option-ref options 'machine "32"))
(info (if (equal? machine "32") (x86-info) (x86_64-info))))
(c99-ast->info info ast)))
(define (mescc:assemble options) (define (mescc:assemble options)
(let* ((files (option-ref options '() '("a.c"))) (let* ((files (option-ref options '() '("a.c")))
@ -161,12 +169,21 @@
((option-ref options 'assemble #f) ((option-ref options 'assemble #f)
(replace-suffix input-file-name ".o")) (replace-suffix input-file-name ".o"))
(else (replace-suffix M1-file-name ".o")))) (else (replace-suffix M1-file-name ".o"))))
(machine (option-ref options 'machine "32"))
(architecture (cond
((equal? machine "32") "1")
((equal? machine "64") "2")
(else "1")))
(m1-macros (cond
((equal? machine "32") "x86.M1")
((equal? machine "64") "x86_64.M1")
(else "x86.M1")))
(verbose? (option-ref options 'verbose #f)) (verbose? (option-ref options 'verbose #f))
(M1 (or (getenv "M1") "M1")) (M1 (or (getenv "M1") "M1"))
(command `(,M1 (command `(,M1
"--LittleEndian" "--LittleEndian"
"--Architecture" "1" "--Architecture" ,architecture
"-f" ,(arch-find options "x86.M1") "-f" ,(arch-find options m1-macros)
,@(append-map (cut list "-f" <>) M1-files) ,@(append-map (cut list "-f" <>) M1-files)
"-o" ,hex2-file-name))) "-o" ,hex2-file-name)))
(when verbose? (when verbose?
@ -179,13 +196,19 @@
(elf-file-name (cond ((option-ref options 'output #f)) (elf-file-name (cond ((option-ref options 'output #f))
(else (replace-suffix input-file-name "")))) (else (replace-suffix input-file-name ""))))
(verbose? (option-ref options 'verbose #f)) (verbose? (option-ref options 'verbose #f))
(elf-footer (or elf-footer (arch-find options "elf32-footer-single-main.hex2")))
(hex2 (or (getenv "HEX2") "hex2")) (hex2 (or (getenv "HEX2") "hex2"))
(machine (option-ref options 'machine "32"))
(architecture (cond
((equal? machine "32") "1")
((equal? machine "64") "2")
(else "1")))
(base-address (option-ref options 'base-address "0x1000000"))
(elf-footer (or elf-footer (arch-find options (string-append"elf" machine "-footer-single-main.hex2"))))
(command `(,hex2 (command `(,hex2
"--LittleEndian" "--LittleEndian"
"--Architecture" "1" "--Architecture" ,architecture
"--BaseAddress" "0x1000000" "--BaseAddress" ,base-address
"-f" ,(arch-find options "elf32-header.hex2") "-f" ,(arch-find options (string-append "elf" machine "-header.hex2"))
"-f" ,(arch-find options "crt1.o") "-f" ,(arch-find options "crt1.o")
,@(append-map (cut list "-f" <>) hex2-files) ,@(append-map (cut list "-f" <>) hex2-files)
"-f" ,elf-footer "-f" ,elf-footer
@ -203,8 +226,13 @@
(blood-elf-footer (string-append hex2-file-name ".blood-elf")) (blood-elf-footer (string-append hex2-file-name ".blood-elf"))
(verbose? (option-ref options 'verbose #f)) (verbose? (option-ref options 'verbose #f))
(blood-elf (or (getenv "BLOOD_ELF") "blood-elf")) (blood-elf (or (getenv "BLOOD_ELF") "blood-elf"))
(machine (option-ref options 'machine "32"))
(m1-macros (cond
((equal? machine "32") "x86.M1")
((equal? machine "64") "x86_64.M1")
(else "x86.M1")))
(command `(,blood-elf (command `(,blood-elf
"-f" ,(arch-find options "x86.M1") "-f" ,(arch-find options m1-macros)
,@(append-map (cut list "-f" <>) M1-files) ,@(append-map (cut list "-f" <>) M1-files)
"-o" ,M1-blood-elf-footer))) "-o" ,M1-blood-elf-footer)))
(when verbose? (when verbose?
@ -225,10 +253,15 @@
(define* (arch-find options file-name) (define* (arch-find options file-name)
(let* ((srcdest (or (getenv "srcdest") "")) (let* ((srcdest (or (getenv "srcdest") ""))
(srcdir-lib (string-append srcdest "lib")) (srcdir-lib (string-append srcdest "lib"))
(machine (option-ref options 'machine "32"))
(arch (cond
((equal? machine "32") "x86-mes")
((equal? machine "64") "x86_64-mes")
(else "x86-mes")))
(path (cons* srcdir-lib (path (cons* srcdir-lib
(prefix-file options "lib") (prefix-file options "lib")
(filter-map (multi-opt 'library-dir) options))) (filter-map (multi-opt 'library-dir) options)))
(arch-file-name (string-append "x86-mes/" file-name)) (arch-file-name (string-append arch "/" file-name))
(verbose? (option-ref options 'verbose #f))) (verbose? (option-ref options 'verbose #f)))
(when verbose? (when verbose?
(stderr "arch-find=~s\n" arch-file-name) (stderr "arch-find=~s\n" arch-file-name)

1
module/mescc/preprocess.scm
View file

@ -81,7 +81,6 @@
#:cpp-defs `( #:cpp-defs `(
"NULL=0" "NULL=0"
"__linux__=1" "__linux__=1"
"__i386__=1"
"POSIX=0" "POSIX=0"
"_POSIX_SOURCE=0" "_POSIX_SOURCE=0"
"__STDC__=1" "__STDC__=1"

91
module/mescc/x86_64/as.scm Normal file
View file

@ -0,0 +1,91 @@
;;; 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/>.
;;; Commentary:
;;; Define x86_64 M1 assembly
;;; Code:
(define-module (mescc x86_64 as)
#:use-module (mes guile)
#:use-module (mescc as)
#:use-module (mescc info)
#:export (
x86_64:instructions
))
(define (x86_64:function-preamble . rest)
'(("push___%rbp")
("mov____%rsp,%rbp")
;;("mov____%rdi,0x8(%rbp)" "!-0x08")
;;("mov____%rsi,0x8(%rbp)" "!-0x10")
;;("mov____%rdx,0x8(%rbp)" "!-0x18")
;;("mov____%rcx,0x8(%rbp)" "!-0x20")
))
(define (x86_64:function-locals . rest)
`(
;; FIXME: how on x86_64?
("sub____$i32,%rsp" (#:immediate ,(+ (* 4 1025) (* 20 8))))
)) ; 4*1024 buf, 20 local vars
(define (x86_64:r0->local info n)
(or n (error "invalid value: x86_64:r0->local: " n))
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
(n (- 0 (* 8 n))))
`(,(if (< (abs n) #x80) `(,(string-append "mov____%" r0 ",0x8(%rbp)") (#:immediate1 ,n))
`(,(string-append "mov____%" r0 ",0x32(%rbp)") (#:immediate ,n))))))
(define (x86_64:value->r0 info v)
(or v (error "invalid value: x86_64:value->r0: " v))
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
`((,(string-append "mov____$i32,%" r0) (#:immediate ,v)))))
(define (x86_64:ret . rest)
'(("mov____%rbp,%rsp")
("pop____%rbp")
("ret")))
(define (x86_64:r0-zero? info)
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
`((,(string-append "test___%" r0 "," "%" r0)))))
(define (x86_64:local->r0 info n)
(or n (error "invalid value: x86_64:local->r0: " n))
(let ((r0 (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
(n (- 0 (* 8 n))))
`(,(if (< (abs n) #x80) `(,(string-append "mov____0x8(%rbp),%" r0) (#:immediate1 ,n))
`(,(string-append "mov____0x32(%rbp),%" r0) (#:immediate ,n))))))
(define (x86_64:call-label info label n)
`((call32 (#:offset ,label))
;;("add____$i8,%esp" (#:immediate1 ,(* n 4)))
))
(define x86_64:instructions
`(
(call-label . ,x86_64:call-label)
(function-preamble . ,x86_64:function-preamble)
(function-locals . ,x86_64:function-locals)
(local->r0 . ,x86_64:local->r0)
(r0->local . ,x86_64:r0->local)
(r0-zero? . ,x86_64:r0-zero?)
(ret . ,x86_64:ret)
(value->r0 . ,x86_64:value->r0)
))

68
module/mescc/x86_64/info.scm Normal file
View file

@ -0,0 +1,68 @@
;;; 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/>.
;;; Commentary:
;;; Initialize MesCC as i386/x86 compiler
;;; Code:
(define-module (mescc x86_64 info)
#:use-module (mescc info)
#:use-module (mescc x86_64 as)
#:export (x86_64-info))
(define (x86_64-info)
(make <info> #:types x86_64:type-alist #:registers x86_64:registers #:instructions x86_64:instructions))
;; FIXME: use abstract, unlimited R0...RN and make concrete in second pass?
(define x86_64:registers '("rax" "rdi" "rsi" "rdx" "rcx" "r8" "r9"))
(define x86_64: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))
;;("long long" . ,(make-type 'signed 8 #f))
;;("long long int" . ,(make-type 'signed 8 #f))
("long long" . ,(make-type 'signed 8 #f)) ;; FIXME
("long long int" . ,(make-type 'signed 8 #f))
("void" . ,(make-type 'void 1 #f))
;; FIXME sign
("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 'builtin 8 #f))
;; ("unsigned long long int" . ,(make-type 'builtin 8 #f))
("unsigned long long" . ,(make-type 'unsigned 8 #f)) ;; FIXME
("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 16 #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))))

5
scripts/mescc.in
View file

@ -73,6 +73,7 @@ fi
(define (parse-opts args) (define (parse-opts args)
(let* ((option-spec (let* ((option-spec
'((assemble (single-char #\c)) '((assemble (single-char #\c))
(base-address (value #t))
(compile (single-char #\S)) (compile (single-char #\S))
(define (single-char #\D) (value #t)) (define (single-char #\D) (value #t))
(debug-info (single-char #\g)) (debug-info (single-char #\g))
@ -80,6 +81,7 @@ fi
(include (single-char #\I) (value #t)) (include (single-char #\I) (value #t))
(library-dir (single-char #\L) (value #t)) (library-dir (single-char #\L) (value #t))
(library (single-char #\l) (value #t)) (library (single-char #\l) (value #t))
(machine (single-char #\m) (value #t))
(preprocess (single-char #\E)) (preprocess (single-char #\E))
(output (single-char #\o) (value #t)) (output (single-char #\o) (value #t))
(version (single-char #\V)) (version (single-char #\V))
@ -97,6 +99,8 @@ fi
(format (or (and usage? (current-error-port)) (current-output-port)) "\ (format (or (and usage? (current-error-port)) (current-output-port)) "\
Usage: mescc [OPTION]... FILE... Usage: mescc [OPTION]... FILE...
-c preprocess, compile and assemble only; do not link -c preprocess, compile and assemble only; do not link
--base-address=ADRRESS
use BaseAddress ADDRESS [0x1000000]
-D DEFINE[=VALUE] define DEFINE [VALUE=1] -D DEFINE[=VALUE] define DEFINE [VALUE=1]
-E preprocess only; do not compile, assemble or link -E preprocess only; do not compile, assemble or link
-g add debug info [GDB, objdump] TODO: hex2 footer -g add debug info [GDB, objdump] TODO: hex2 footer
@ -104,6 +108,7 @@ Usage: mescc [OPTION]... FILE...
-I DIR append DIR to include path -I DIR append DIR to include path
-L DIR append DIR to library path -L DIR append DIR to library path
-l LIBNAME link with LIBNAME -l LIBNAME link with LIBNAME
-m BITS compile for BITS bits [32]
-o FILE write output to FILE -o FILE write output to FILE
-S preprocess and compile only; do not assemble or link -S preprocess and compile only; do not assemble or link
-v, --version display version and exit -v, --version display version and exit