mescc: Initial x86_64 support.
authorJan Nieuwenhuizen <janneke@gnu.org>
Tue, 14 Aug 2018 18:32:56 +0000 (20:32 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Tue, 14 Aug 2018 18:32:56 +0000 (20:32 +0200)
    make all-go && MES=guile ./pre-inst-env scripts/mescc -m64 -c scaffold/main.c

27 files changed:
.gitignore
build-aux/build-guile.sh
build-aux/build-x86_64-mes.sh
build-aux/cc-x86_64-mes.sh [new file with mode: 0755]
build-aux/config.sh
lib/linux/x86_64-mes-gcc/crt1.c
lib/linux/x86_64-mes/crt1 [new file with mode: 0644]
lib/linux/x86_64-mes/crt1.c [new file with mode: 0644]
lib/x86-mes/x86.M1
lib/x86_64-mes/elf64-footer-single-main.hex2
lib/x86_64-mes/elf64-header.hex2
lib/x86_64-mes/x86_64.M1 [new file with mode: 0644]
mes/module/mescc/i386/as.mes
mes/module/mescc/i386/info.mes [new file with mode: 0644]
mes/module/mescc/mescc.mes
mes/module/mescc/x86_64/as.mes [new file with mode: 0644]
mes/module/mescc/x86_64/info.mes [new file with mode: 0644]
module/mescc/as.scm
module/mescc/compile.scm
module/mescc/i386/as.scm
module/mescc/i386/info.scm
module/mescc/info.scm
module/mescc/mescc.scm
module/mescc/preprocess.scm
module/mescc/x86_64/as.scm [new file with mode: 0644]
module/mescc/x86_64/info.scm [new file with mode: 0644]
scripts/mescc.in

index c3fc54c5abede5ecdc8454f4d57748f402ebdf91..da8824a88ba35643533c48d4b409bb759e9569fb 100644 (file)
 *.x86-out
 *.x86_64-mes-gcc-o
 *.x86_64-mes-gcc-out
+*.x86_64-mes-o
 *.x86_64-mes-out
 *.x86_64-out
 
-
 /src/*.h
 /src/*.i
 /src/mes
index 1a93fab6bdcbc87d337e2152193ad4476b7a1e50..4e28d2536dd83fc4d787e0dc5e9190824275ab2b 100755 (executable)
@@ -39,6 +39,8 @@ ${srcdest}module/mescc/bytevectors.scm
 ${srcdest}module/mescc/compile.scm
 ${srcdest}module/mescc/i386/as.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/mescc.scm
 ${srcdest}module/mescc/preprocess.scm
index c157671078dcbc356ab8e4a070b937a7b49c671e..c7eff73ee693a00fbb5ad4352aa09ec185265f7c 100755 (executable)
@@ -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
 # fi
 
-# PREPROCESS=1
-# if [ ! -d "$MES_SEED" ] \
-#        && [ "$ARCH" = "i386" \
-#             -o "$ARCH" = "i586" \
-#             -o "$ARCH" = "i686" ]; then
-#     MES_ARENA=100000000
-# fi
 
-# MES_ARENA=100000000
-# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crt0
-# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc-mini
+PREPROCESS=1
+if [ ! -d "$MES_SEED" ] \
+       && [ "$ARCH" = "i386" \
+            -o "$ARCH" = "i586" \
+            -o "$ARCH" = "i686" ]; then
+    MES_ARENA=100000000
+fi
+
+ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/linux/x86_64-mes/crt1
 
-# PREPROCESS= bash ${srcdest}build-aux/cc-mes.sh lib/x86_64-mes/exit-42
+MES_LIBS='-l none' PREPROCESS= bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/x86_64-mes/exit-42
+
+trace "TEST       lib/x86_64-mes/exit-42.x86_64-mes-out" echo lib/x86_64-mes/exit-42.x86_64-mes-out
+{ set +e; lib/x86_64-mes/exit-42.x86_64-mes-out; r=$?; set -e; }
+[ $r != 42 ] && echo "  => $r" && exit 1
 
-# trace "TEST exit-42.x86_64-mes-out"
-# { 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-x86_64-mes.sh lib/libc-mini
 
-# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crt1
-# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crti
-# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/crtn
+# 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/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
 # 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/hello
-# bash ${srcdest}build-aux/cc-mes.sh scaffold/argv
-# bash ${srcdest}build-aux/cc-mes.sh scaffold/malloc
-# ##sh ${srcdest}build-aux/cc-mes.sh scaffold/micro-mes
-# ##sh ${srcdest}build-aux/cc-mes.sh scaffold/tiny-mes
-# # bash ${srcdest}build-aux/cc-mes.sh scaffold/mini-mes
-# bash ${srcdest}build-aux/cc-mes.sh src/mes
+MES_LIBS='-l none' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/main
+
+trace "TEST       scaffold/main.x86_64-mes-out" echo scaffold/main.x86_64-mes-out
+{ set +e; scaffold/main.x86_64-mes-out; r=$?; set -e; }
+[ $r != 42 ] && echo "  => $r" && exit 1
+
+# MES_LIBS='-l mini' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/hello
+# 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
 true
diff --git a/build-aux/cc-x86_64-mes.sh b/build-aux/cc-x86_64-mes.sh
new file mode 100755 (executable)
index 0000000..e551b07
--- /dev/null
@@ -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
index 4fa84441480c489f3f9bfca27dfd309427de02c0..f1a848868259f2c98f728a9d27adcb9f473a8483 100644 (file)
@@ -153,7 +153,8 @@ MES_CPPFLAGS=${MES_CPPFLAGS-"
 MES_CFLAGS=${MES_CFLAGS-"
 "}
 
-MES_CFLAGS=${MES_CFLAGS-"
+MES64_CFLAGS=${MES64_CFLAGS-"
+-m64
 "}
 
 M1FLAGS=${M1FLAGS-"
index 4693e0f68c07debe83ebae2f1fb512c3fbf57c2a..e1c6619c44454fd5fb73a37629c63c89765831c8 100644 (file)
@@ -28,9 +28,9 @@ void
 _start ()
 {
   asm (
-       "movq    %%rbp,%%rax\n\t"
+       "mov     %%rbp,%%rax\n\t"
        "add     $8,%%rax\n\t"
-       "movq    (%%rax),%%rax\n\t"
+       "mov     (%%rax),%%rax\n\t"
        "add     $3,%%rax\n\t"
        "shl     $3,%%rax\n\t"
        "add     %%rbp,%%rax\n\t"
diff --git a/lib/linux/x86_64-mes/crt1 b/lib/linux/x86_64-mes/crt1
new file mode 100644 (file)
index 0000000..80ac20f
Binary files /dev/null and b/lib/linux/x86_64-mes/crt1 differ
diff --git a/lib/linux/x86_64-mes/crt1.c b/lib/linux/x86_64-mes/crt1.c
new file mode 100644 (file)
index 0000000..a63c8be
--- /dev/null
@@ -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");
+}
index 43f06acce4a5b5e6c8d58d091d9a39f42a693c47..978f330917af01683e45899baa6642747272bed5 100644 (file)
@@ -186,13 +186,13 @@ DEFINE setne__%al 0f95c0
 DEFINE shl____$i8,%eax c1e0
 DEFINE shl____%cl,%eax d3e0
 DEFINE shr____%cl,%eax d3e8
+DEFINE sub____$8,%esp 83ec
+DEFINE sub____$i32,%esp 81ec
 DEFINE sub____%al,%dl 28d0
 DEFINE sub____%dl,%al 28c2
 DEFINE sub____%eax,%edx 29c2
 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___%eax,%eax 85c0
 DEFINE xchg___%eax,(%esp) 870424
@@ -204,6 +204,10 @@ DEFINE xor____%ecx,%ecx 31c9
 DEFINE xor____%edx,%eax 31d0
 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_fork   02000000
 DEFINE SYS_read   03000000
index 6caed915c902be84c5561d238418bfb843f1693e..16275111b553b6ebe9fe471780eb6797030e4e70 100644 (file)
@@ -34,7 +34,7 @@
 
 00 00 00
 
-# @240
+# @370
 :ELF_sym
 00 00 00 00                    # st-name
 00                             # st-info = stt-func= 2
index 582b87437cecdd2045adcbe3e62052b7e143d4a1..174f4f8c49e9db7772f65b69a4bc5841687f8d15 100644 (file)
 
 00 00 00 00 00 00 00           # e_ident[EI_PAD]
 
+# 0x10
 02 00                          # e_type Indicating Executable
 3e 00                          # e_machine Indicating AMD64
 01 00 00 00                    # e_version Indicating original elf
 
+# 0x18
 &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
   00 00 00 00
 00 00 00 00 00 00 00 00         # sh_length
 00 00 00 00                     # sh_link
 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
 
 ## FIXME: M0 for calculations?
 
 :ELF_section_header_sym
 %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
 00 00 00 00 00 00 00 00        # sh_flags
 &ELF_sym 00 00 00 00           # sh_addr
 %ELF_end>ELF_sym 00 00 00 00   # sh_length
 06 00 00 00                    # sh_link:6
 00 00 00 00                    # sh_info
-00 00 00 00 00 00 00 00        # sh_1?
-40 00 00 00 00 00 00 00        # sh_entsize
+01 00 00 00 00 00 00 00        # sh_1?
+18 00 00 00 00 00 00 00        # sh_entsize
 
 :ELF_section_header_str
 %ELF_shstr__str>ELF_shstr      # sh_name
diff --git a/lib/x86_64-mes/x86_64.M1 b/lib/x86_64-mes/x86_64.M1
new file mode 100644 (file)
index 0000000..4178160
--- /dev/null
@@ -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
index f1c97a28da8ed75d9b7b3b223926acb0167b2255..c65bbcb411dd13bfc1e70f15e2880f1d2bbee47b 100644 (file)
@@ -19,4 +19,5 @@
 ;;; 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/i386/as.scm")
diff --git a/mes/module/mescc/i386/info.mes b/mes/module/mescc/i386/info.mes
new file mode 100644 (file)
index 0000000..47a502d
--- /dev/null
@@ -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")
index 6e8c9a04a3a856b747812e8b0fe880a5ba9592bf..873708876b3d81773917fd915b18289ab97464d3 100644 (file)
 (mes-use-module (srfi srfi-26))
 (mes-use-module (mes misc))
 (mes-use-module (mes getopt-long))
-
 (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 compile))
 (mes-use-module (mescc M1))
diff --git a/mes/module/mescc/x86_64/as.mes b/mes/module/mescc/x86_64/as.mes
new file mode 100644 (file)
index 0000000..e83f3f6
--- /dev/null
@@ -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")
diff --git a/mes/module/mescc/x86_64/info.mes b/mes/module/mescc/x86_64/info.mes
new file mode 100644 (file)
index 0000000..d86ea01
--- /dev/null
@@ -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")
index af63d3b3cd367364cc054a6b5d385f4189a51e9a..b2e650d0c236128d17e229d78f234ee59d57a458 100644 (file)
@@ -20,7 +20,9 @@
   #:use-module (srfi srfi-1)
   #:use-module (mes guile)
   #:use-module (mescc bytevectors)
-  #:export (dec->hex
+  #:use-module (mescc info)
+  #:export (as
+            dec->hex
             int->bv8
             int->bv16
             int->bv32))
@@ -44,3 +46,7 @@
   (cond ((number? o) (number->string o 16))
         ((char? o) (number->string (char->integer o) 16))
         (else (format #f "~s" o))))
+
+(define (as info instruction . rest)
+  (let ((proc (assoc-ref (.instructions info) instruction)))
+    (apply proc info rest)))
index ce7b98e4ca04562279ee8da1508e38b1d26452f9..e57541d6c38601ef631d73ff899befd0420abd84 100644 (file)
 (define (number->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)
   (lambda (o)
     (cond ((assoc-ref (.locals info) o)
                               (if (<= size 4) (wrap-as (i386:accu->label global))
                                   (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)
   (lambda (o value)
     (cond ((assoc-ref (.locals info) o)
 
 (define (alloc-register info)
   (let ((registers (.registers info)))
-    (stderr " =>register: ~a\n" (car registers))
-    (clone info #:allocated (cons (car registers) (.allocated info)) #:registers (cdr registers))))
+    ;; (stderr "\nalloc-register")
+    ;; (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)
   (let ((allocated (.allocated info)))
-    (stderr " <=register: ~a\n" (car allocated))
-   (clone info #:allocated (cdr allocated) #:registers (cons (car allocated) (.registers info)))))
+    ;; (stderr " <=register: ~a\n" (car allocated))
+    ;; (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)
 
       info)))
 
 (define (expr->register o info)
-  (stderr "expr->register o=~s\n" o)
+  ;;(stderr "expr->register o=~s\n" o)
 
   (let ((locals (.locals info))
         (text (.text info))
         ((p-expr (fixed ,value))
          (let ((value (cstring->int value))
                (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))
          (let ((value (cstring->float value)))
         (,char (guard (char? char)) (append-text info (wrap-as (i386:value->accu char))))
 
         ((p-expr (ident ,name))
-         (append-text info ((ident->accu info) name)))
+         (append-text info ((ident->r0 info) name)))
 
         ((initzer ,initzer)
          (expr->register initzer info))
                               (not (assoc name globals))
                               (not (equal? name (.function info))))
                          (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 '()))
                           (accu (expr->register `(p-expr (ident ,name)) empty)))
                      (append-text args-info (append (.text accu)
            (append-text info ((ident-add info) name (- size)))))
 
         ((assn-expr ,a (op ,op) ,b)
-         (stderr "ASSN!\n")
          (let* ((info (append-text info (ast->comment o)))
                 (type (ast->type a info))
                 (rank (->rank type))
                                 (or (= size-b 1) (= size-b 2)))))
              (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 "   assign a=~s\n" a)
            (pmatch a
              ((p-expr (ident ,name))
               (if (or (<= size 4) ;; FIXME: long long = int
-                      (<= size-b 4)) (append-text info ((accu->ident info) name))
-                      (let* ((info (expr->base* a info))
-                             (info (accu->base-mem*n info size)))
-                        ;;???
+                      (<= size-b 4)) (append-text info ((r0->ident info) name))
+                      (let* (;;(info (expr->register* a info))
+                             (info (expr->base* a info))
+                             (info (r0->r1-mem*n info size)))
                         (free-register info))))
              (_ (let* ((info (expr->base* a info))
                        (info (if (not (bit-field? type)) info
                (wrap-as (i386:word-accu)))
               (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)
   (let* ((info (append-text info (wrap-as (i386:push-accu))))
          (info (expr->register o info))
                                                  4)))
                                   ((jump (if (= size 1) i386:jump-byte-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))
                              (size (if (= rank 1) (ast-type->size info expr)
                                        4)))
                         ((jump (if (= size 1) i386:jump-byte-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)
        ((jump i386:jump-z
               (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)
   (let ((o (cond ((string-suffix? "ULL" o) (string-drop-right o 3))
     (_ (error "ptr-declr->rank not supported: " o))))
 
 (define (ast->info o info)
-  (stderr "ast->info o=~s\n" o)
+  ;; (stderr "ast->info o=~s\n" o)
   (let ((functions (.functions info))
         (globals (.globals info))
         (locals (.locals info))
                                  (append-text info (wrap-as (asm->m1 arg0))))
            (let* ((info (append-text info (ast->comment o)))
                   (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)
        (let* ((info (append-text info (ast->comment `(if ,test (ellipsis)))))
 
       ((return ,expr)
        (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)
        ;;FIXME: ridiculous performance hit with mes
       ;; EXPR
       ((expr-stmt ,expression)
        (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)))
 
       ;; FIXME: why do we get (post-inc ...) here
       ;; (array-ref
       (_ (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)
   (fold ast->info info o))
     '()
     ))
 
-(define (param-list->text o)
+(define (param-list->text o info)
   (pmatch o
     ((param-list . ,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))
-                        (i386:function-locals)))))
+                        (as info 'function-locals)))))
     (_ (error "param-list->text: not supported: " o))))
 
 (define (param-list->locals o info)
 
 (define (fctn-defn->info o info)
   (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
           (append text return))))
   (let ((name (fctn-defn:get-name o)))
     (mescc:trace name)
     (let* ((type (fctn-defn:get-type info o))
            (formals (fctn-defn:get-formals o))
-           (text (param-list->text formals))
+           (text (param-list->text formals info))
            (locals (param-list->locals formals info))
            (statement (fctn-defn:get-statement o))
            (function (cons name (make-function name type '())))
index ffd022621f0e7a642aef8c6eda2129a4732a5520..d617a0e847d041fbe844c93187170a32a208f8fc 100644 (file)
@@ -25,6 +25,7 @@
 (define-module (mescc i386 as)
   #:use-module (mes guile)
   #:use-module (mescc as)
+  #:use-module (mescc info)
   #:export (
             i386:accu%base
             i386:accu*base
@@ -86,8 +87,6 @@
             i386:call-accu
             i386:call-label
             i386:formal
-            i386:function-locals
-            i386:function-preamble
             i386:jump
             i386:jump
             i386:jump-a
             i386:push-local
             i386:push-local-address
             i386:push-local-de-ref
-            i386:ret
             i386:ret-local
             i386:sub-base
             i386:test-base
             i386:signed-byte-accu
             i386:word-accu
             i386:signed-word-accu
+
+            i386:instructions
             ))
 
 (define (i386:nop)
   '(("nop")))
 
-(define (i386:function-preamble)
+(define (i386:function-preamble . rest)
   '(("push___%ebp")
     ("mov____%esp,%ebp")))
 
-(define (i386:function-locals)
-  `(("sub____%esp,$i32" (#:immediate ,(+ (* 4 1025) (* 20 4)))))) ; sub %esp,xxx 4*1024 buf, 20 local vars
+(define (i386:function-locals . rest)
+  `(("sub____$i32,%esp" (#:immediate ,(+ (* 4 1025) (* 20 4)))))) ; 4*1024 buf, 20 local vars
 
 (define (i386:push-label label)
   `(("push___$i32" (#:address ,label)))) ; push  $0x<label>
 (define (i386:push-base)
   '(("push___%edx")))                   ; push %edx
 
-(define (i386:ret)
-  '(("leave")                           ; leave
-    ("ret")))                           ; ret
+(define (i386:ret . rest)
+  '(("leave")
+    ("ret")))
 
 (define (i386:accu->base)
   '(("mov____%eax,%edx")))              ; mov    %eax,%edx
 
 (define (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)
   `(("mov____$i32,(%eax)" (#:immediate ,v)))) ; movl   $0x<v>,(%eax)
   `(("mov____$i32,0x32" (#:address ,label)
      (#:immediate ,v))))
 
-(define (i386:call-label label n)
+(define (i386:call-label info label n)
   `((call32 (#:offset ,label))
     ("add____$i8,%esp" (#:immediate1 ,(* n 4)))))
 
 
 (define (i386:signed-word-accu)
   '(("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)
+    ))
index af83cbd7dd3b3517026d59acc0bd3d70c5d30390..ed6f25f85e5799800701bc15b2f3ed167b80009f 100644 (file)
 
 (define-module (mescc i386 info)
   #:use-module (mescc info)
+  #:use-module (mescc i386 as)
   #:export (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?
 (define i386:registers '("eax" "ebx" "ecx" "edx" "esi"))
index 06f8b6aa96e93f05c7fd830eb3c0fa967ffd67bf..bdb04d103db18b5170be2fb3f4aa0da101aa38b9 100644 (file)
@@ -46,6 +46,7 @@
             .continue
             .allocated
             .registers
+            .instructions
 
             <type>
             make-type
             structured-type?))
 
 (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?
   (types .types)
   (constants .constants)
   (post .post)
   (break .break)
   (continue .continue)
+  (allocated .allocated)
   (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>)
-         (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)
   (cond ((info? o)
                (break (.break o))
                (continue (.continue o))
                (allocated (.allocated o))
-               (registers (.registers o)))
+               (registers (.registers o))
+               (instructions (.instructions o)))
            (let-keywords rest
                          #f
                          ((types types)
                           (break break)
                           (continue continue)
                           (allocated allocated)
-                          (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))))))
+                          (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))
 ;;           (make-type 'enum 4 0 fields)
index 89d0116b1bd1b3b7d2e95479341e35db56f5b588..48c5b1f6b3c3cb9ac6e7bfda5e67393eb153de30 100644 (file)
@@ -25,6 +25,7 @@
   #:use-module (mes misc)
 
   #:use-module (mescc i386 info)
+  #:use-module (mescc x86_64 info)
   #:use-module (mescc preprocess)
   #:use-module (mescc compile)
   #:use-module (mescc M1)
@@ -33,8 +34,6 @@
             mescc:assemble
             mescc:link))
 
-(define %info (x86-info))
-
 (define GUILE-with-output-to-file with-output-to-file)
 (define (with-output-to-file file-name thunk)
   (if (equal? file-name "-") (thunk)
          (defines (reverse (filter-map (multi-opt 'define) options)))
          (includes (reverse (filter-map (multi-opt 'include) options)))
          (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
       (lambda _ (for-each (cut c->ast prefix defines includes write <>) files)))))
 
          (includes (reverse (filter-map (multi-opt 'include) options)))
          (dir (dirname file-name))
          (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
-      (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)
-  (let ((ast (with-input-from-file file-name read)))
-    (c99-ast->info %info ast)))
+  (let* ((ast (with-input-from-file file-name read))
+         (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)
   (let* ((files (option-ref options '() '("a.c")))
                                ((option-ref options 'assemble #f)
                                 (replace-suffix input-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))
          (M1 (or (getenv "M1") "M1"))
          (command `(,M1
                     "--LittleEndian"
-                    "--Architecture" "1"
-                    "-f" ,(arch-find options "x86.M1")
+                    "--Architecture" ,architecture
+                    "-f" ,(arch-find options m1-macros)
                     ,@(append-map (cut list "-f" <>) M1-files)
                     "-o" ,hex2-file-name)))
     (when verbose?
          (elf-file-name (cond ((option-ref options 'output #f))
                               (else (replace-suffix input-file-name ""))))
          (verbose? (option-ref options 'verbose #f))
-         (elf-footer (or elf-footer (arch-find options "elf32-footer-single-main.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
                     "--LittleEndian"
-                    "--Architecture" "1"
-                    "--BaseAddress" "0x1000000"
-                    "-f" ,(arch-find options "elf32-header.hex2")
+                    "--Architecture" ,architecture
+                    "--BaseAddress" ,base-address
+                    "-f" ,(arch-find options (string-append "elf" machine "-header.hex2"))
                     "-f" ,(arch-find options "crt1.o")
                     ,@(append-map (cut list "-f" <>) hex2-files)
                     "-f" ,elf-footer
          (blood-elf-footer (string-append hex2-file-name ".blood-elf"))
          (verbose? (option-ref options 'verbose #f))
          (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
-                      "-f" ,(arch-find options "x86.M1")
+                      "-f" ,(arch-find options m1-macros)
                       ,@(append-map (cut list "-f" <>) M1-files)
                       "-o" ,M1-blood-elf-footer)))
     (when verbose?
 (define* (arch-find options file-name)
   (let* ((srcdest (or (getenv "srcdest") ""))
          (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
                       (prefix-file options "lib")
                       (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)))
     (when verbose?
       (stderr "arch-find=~s\n" arch-file-name)
index c2efb32c6c5781c875cf995162070ed635b6eee0..aa2dc9f5a11a24e99719df859096216e11de49b6 100644 (file)
@@ -81,7 +81,6 @@
      #:cpp-defs `(
                   "NULL=0"
                   "__linux__=1"
-                  "__i386__=1"
                   "POSIX=0"
                   "_POSIX_SOURCE=0"
                   "__STDC__=1"
diff --git a/module/mescc/x86_64/as.scm b/module/mescc/x86_64/as.scm
new file mode 100644 (file)
index 0000000..b5217e7
--- /dev/null
@@ -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)
+    ))
diff --git a/module/mescc/x86_64/info.scm b/module/mescc/x86_64/info.scm
new file mode 100644 (file)
index 0000000..d65bc50
--- /dev/null
@@ -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))))
index d3a148c620c22818f96b4e78454c0e543eb5b576..3a3157f1612ef9791f1111daeac23c46da288181 100755 (executable)
@@ -73,6 +73,7 @@ fi
 (define (parse-opts args)
   (let* ((option-spec
           '((assemble (single-char #\c))
+            (base-address (value #t))
             (compile (single-char #\S))
             (define (single-char #\D) (value #t))
             (debug-info (single-char #\g))
@@ -80,6 +81,7 @@ fi
             (include (single-char #\I) (value #t))
             (library-dir (single-char #\L) (value #t))
             (library (single-char #\l) (value #t))
+            (machine (single-char #\m) (value #t))
             (preprocess (single-char #\E))
             (output (single-char #\o) (value #t))
             (version (single-char #\V))
@@ -97,6 +99,8 @@ fi
           (format (or (and usage? (current-error-port)) (current-output-port)) "\
 Usage: mescc [OPTION]... FILE...
   -c                 preprocess, compile and assemble only; do not link
+  --base-address=ADRRESS
+                     use BaseAddress ADDRESS [0x1000000]
   -D DEFINE[=VALUE]  define DEFINE [VALUE=1]
   -E                 preprocess only; do not compile, assemble or link
   -g                 add debug info [GDB, objdump] TODO: hex2 footer
@@ -104,6 +108,7 @@ Usage: mescc [OPTION]... FILE...
   -I DIR             append DIR to include path
   -L DIR             append DIR to library path
   -l LIBNAME         link with LIBNAME
+  -m BITS            compile for BITS bits [32]
   -o FILE            write output to FILE
   -S                 preprocess and compile only; do not assemble or link
   -v, --version      display version and exit