mescc: x86_64 support: Refactor to abstracted assembly, add x86_64.
authorJan Nieuwenhuizen <janneke@gnu.org>
Wed, 15 Aug 2018 16:26:55 +0000 (18:26 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 15 Aug 2018 16:26:55 +0000 (18:26 +0200)
* module/mescc/as.scm: Support abstracted assembly.
* module/mescc/i386/as.scm: Rewrite.
* module/mescc/x86_64/as.scm: Implement.
* module/mescc/compile.scm: Refactor to abstracted assembly.
* module/mescc/M1.scm: Update for partial 64 bit support.
* module/mescc/bytevectors.scm (bytevector-u64-native-set!): New
procedure.
* module/mescc/i386/info.scm (i386:type-alist): Use 4 byte type length
also for faking double, long long, long double.
* module/mescc/info.scm:modified:
* module/mescc/x86_64/info.scm (x86_64:registers): New variable.
* lib/x86-mes/x86.M1: Update for new register scheme.
* lib/x86_64-mes/x86_64.M1: Implement.
* lib/x86-mes/setjmp.c: Implement.
* lib/x86_64-mes-gcc/setjmp.c: Implement.
* build-aux/build-cc.sh: Update for x86_64.
* build-aux/build-cc32.sh: Likewise.
* build-aux/build-mes.sh: Likewise.
* build-aux/build-x86_64-mes.sh: Likewise.
* build-aux/check-mescc.sh: Likewise.
* build-aux/test64.sh: Likewise.
* include/libmes.h: Likewise.
* include/setjmp.h: Likewise.
* include/signal.h: Likewise.
* include/stdarg.h: Likewise.
* include/sys/stat.h: Likewise.
* include/sys/types.h: Likewise.
* include/sys/wait.h: Likewise.
* include/unistd.h: Likewise.
* lib/libc+gnu.c: Likewise.
* lib/libc+tcc.c: Likewise.
* lib/linux/gnu.c: Likewise.
* lib/linux/libc-mini.c: Likewise.
* lib/linux/libc.c: Likewise.
* lib/linux/tcc.c: Likewise.
* lib/linux/x86_64-mes-gcc/mes.c: Likewise.
* lib/linux/x86_64-mes/crt1.c: Likewise.
* lib/mes/abtol.c: Likewise.
* lib/posix/mktemp.c: Likewise.
* lib/posix/wait.c: Likewise.
* lib/stdio/fopen.c: Likewise.
* lib/stdio/fputc.c: Likewise.
* lib/stdio/fseek.c: Likewise.
* lib/stdio/printf.c: Likewise.
* lib/stdio/sprintf.c: Likewise.
* lib/stdio/vfprintf.c: Likewise.
* lib/stdio/vsprintf.c: Likewise.
* lib/stdio/vsscanf.c: Likewise.
* lib/stdlib/qsort.c: Likewise.
* lib/x86-mes-gcc/setjmp.c: Likewise.
* scaffold/tests/11-if-1.c: Likewise.
* scaffold/tests/15-if-!f.c: Likewise.
* scaffold/tests/16-if-t.c: Likewise.
* scaffold/tests/21-char[].c: Likewise.
* scaffold/tests/23-pointer.c: Likewise.
* scaffold/tests/32-compare.c: Likewise.
* scaffold/tests/33-and-or.c: Likewise.
* scaffold/tests/34-pre-post.c: Likewise.
* scaffold/tests/35-compare-char.c: Likewise.
* scaffold/tests/36-compare-arithmetic.c: Likewise.
* scaffold/tests/37-compare-assign.c: Likewise.
* scaffold/tests/38-compare-call.c: Likewise.
* scaffold/tests/40-if-else.c: Likewise.
* scaffold/tests/41-?.c: Likewise.
* scaffold/tests/42-goto-label.c: Likewise.
* scaffold/tests/43-for-do-while.c: Likewise.
* scaffold/tests/44-switch.c: Likewise.
* scaffold/tests/45-void-call.c: Likewise.
* scaffold/tests/46-function-static.c: Likewise.
* scaffold/tests/51-strcmp.c: Likewise.
* scaffold/tests/51-strncmp.c: Likewise.
* scaffold/tests/53-strcpy.c: Likewise.
* scaffold/tests/54-argv.c: Likewise.
* scaffold/tests/60-math.c: Likewise.
* scaffold/tests/61-array.c: Likewise.
* scaffold/tests/63-struct-cell.c: Likewise.
* scaffold/tests/64-make-cell.c: Likewise.
* scaffold/tests/65-read.c: Likewise.
* scaffold/tests/70-printf.c: Likewise.
* scaffold/tests/71-struct-array.c: Likewise.
* scaffold/tests/72-typedef-struct-def.c: Likewise.
* scaffold/tests/74-multi-line-string.c: Likewise.
* scaffold/tests/76-pointer-arithmetic.c: Likewise.
* scaffold/tests/79-int-array.c: Likewise.
* scaffold/tests/7a-struct-char-array.c: Likewise.
* scaffold/tests/7b-struct-int-array.c: Likewise.
* scaffold/tests/7i-struct-struct.c: Likewise.
* scaffold/tests/7k-for-each-elem.c: Likewise.
* scaffold/tests/7l-struct-any-size-array.c: Likewise.
* scaffold/tests/7o-struct-pre-post.c: Likewise.
* scaffold/tests/7q-bit-field.c: Likewise.
* scaffold/tests/7s-struct-short.c: Likewise.
* scaffold/tests/80-setjmp.c: Likewise.
* scaffold/tests/81-qsort.c: Likewise.
* scaffold/tests/85-sizeof.c: Likewise.
* scaffold/tests/87-sscanf.c: Likewise.
* scaffold/tests/90-strpbrk.c: Likewise.
* scaffold/tests/91-fseek.c: Likewise.
* scaffold/tests/95-signal.c: Likewise.
* scaffold/tests/97-fopen.c: Likewise.
* scaffold/tests/99-readdir.c: Likewise.
* scaffold/tests/t.c: Likewise.
* lib/linux/x86_64-mes/mes.c: New file.
* lib/linux/x86_64-mes/mini.c: New file.
* lib/x86_64-mes/setjmp.c: New file.
* scaffold/tests/06-!call-1.c: New file.
* scaffold/tests/06-call-2.c: New file.
* scaffold/tests/06-call-variable.c: New file.
* scaffold/tests/08-assign-global.c: New file.
* scaffold/tests/08-assign-negative.c: New file.
* scaffold/tests/17-compare-and-or.c: New file.
* scaffold/tests/17-compare-and.c: New file.
* scaffold/tests/17-compare-ge.c: New file.
* scaffold/tests/17-compare-gt.c: New file.
* scaffold/tests/17-compare-le.c: New file.
* scaffold/tests/17-compare-lt.c: New file.
* scaffold/tests/17-compare-or.c: New file.
* scaffold/tests/17-compare-unsigned-ge.c: New file.
* scaffold/tests/17-compare-unsigned-gt.c: New file.
* scaffold/tests/17-compare-unsigned-le.c: New file.
* scaffold/tests/17-compare-unsigned-lt.c: New file.
* scaffold/tests/21-char[]-simple.c: New file.
* scaffold/tests/23-global-pointer-init-null.c: New file.
* scaffold/tests/23-global-pointer-init.c: New file.
* scaffold/tests/23-global-pointer-pointer-ref.c: New file.
* scaffold/tests/23-global-pointer-ref.c: New file.
* scaffold/tests/23-pointer-sub.c: New file.
* scaffold/tests/31-oputs.c: New file.
* scaffold/tests/32-call-wrap.c: New file.
* scaffold/tests/38-compare-call-2.c: New file.
* scaffold/tests/38-compare-call-3.c: New file.
* scaffold/tests/51-pointer-sub.c: New file.
* scaffold/tests/54-argc.c: New file.
* scaffold/tests/63-struct-array-assign.c: New file.
* scaffold/tests/63-struct-array-compare.c: New file.
* scaffold/tests/63-struct-array.c: New file.
* scaffold/tests/63-struct-assign.c: New file.
* scaffold/tests/63-struct-function.c: New file.
* scaffold/tests/63-struct-local.c: New file.
* scaffold/tests/63-struct-pointer.c: New file.
* scaffold/tests/63-struct.c: New file.
* scaffold/tests/70-printf-hello.c: New file.
* scaffold/tests/70-printf-simple.c: New file.
* scaffold/tests/70-stdarg.c: New file.
* scaffold/tests/70-strchr.c: New file.
* scaffold/tests/73-union-hello.c: New file.
* scaffold/tests/76-pointer-arithmetic-pp.c: New file.
* scaffold/tests/79-int-array-simple.c: New file.
* scaffold/tests/7b-struct-int-array-hello.c: New file.
* scaffold/tests/7b-struct-int-array-pointer.c: New file.
* scaffold/tests/7i-struct-struct-simple.c: New file.
* scaffold/tests/7k-for-each-elem-simple.c: New file.
* scaffold/tests/7l-struct-any-size-array-simple.c: New file.
* scaffold/tests/7o-struct-pre-post-simple.c: New file.
* scaffold/tests/7q-bit-field-simple.c: New file.
* scaffold/tests/90-strspn.c: New file.
* scaffold/tests/06-call-string.c.: Rename from 31-eputs.c.
* scaffold/tests/7t-function-destruct.c: Rename from 48-function-destruct.c.
* scaffold/tests/48-global-static.c: Rename from 49-global-static.c.
* scaffold/tests/55-char-array.c:renamed: Rename from 4a-char-array.c.
* scaffold/tests/51-itoa.c:r Rename from 52-itoa.c.
* include/signal.h:(struct sigaction):

187 files changed:
AUTHORS
build-aux/build-cc.sh
build-aux/build-cc32.sh
build-aux/build-mes.sh
build-aux/build-x86_64-mes.sh
build-aux/build.sh.in
build-aux/check-mescc.sh
build-aux/check-tcc.sh
build-aux/test64.sh
include/libmes.h
include/setjmp.h
include/signal.h
include/stdarg.h
include/sys/stat.h
include/sys/types.h
include/unistd.h
lib/libc+tcc.c
lib/linux/gnu.c
lib/linux/libc-mini.c
lib/linux/libc.c
lib/linux/tcc.c
lib/linux/x86-mes-gcc/crt1.c
lib/linux/x86_64-mes-gcc/crt1.c
lib/linux/x86_64-mes-gcc/mes.c
lib/linux/x86_64-mes/crt1.c
lib/linux/x86_64-mes/mes.c [new file with mode: 0644]
lib/linux/x86_64-mes/mini.c [new file with mode: 0644]
lib/mes/abtol.c
lib/posix/mktemp.c
lib/posix/wait.c
lib/stdio/fopen.c
lib/stdio/fputc.c
lib/stdio/fseek.c
lib/stdio/printf.c
lib/stdio/sprintf.c
lib/stdio/vfprintf.c
lib/stdio/vsprintf.c
lib/stdio/vsscanf.c
lib/stdlib/qsort.c
lib/x86-mes-gcc/setjmp.c
lib/x86-mes/setjmp.c
lib/x86-mes/x86.M1
lib/x86_64-mes-gcc/setjmp.c
lib/x86_64-mes/setjmp.c [new file with mode: 0644]
lib/x86_64-mes/x86_64.M1
mes/module/mescc/x86_64/as.mes
mes/module/nyacc/version.mes
module/mescc/M1.scm
module/mescc/as.scm
module/mescc/bytevectors.scm
module/mescc/compile.scm
module/mescc/i386/as.scm
module/mescc/i386/info.scm
module/mescc/info.scm
module/mescc/preprocess.scm
module/mescc/x86_64/as.scm
module/mescc/x86_64/info.scm
scaffold/main.c
scaffold/tests/06-!call-1.c [new file with mode: 0644]
scaffold/tests/06-call-2.c [new file with mode: 0644]
scaffold/tests/06-call-string.c [new file with mode: 0644]
scaffold/tests/06-call-variable.c [new file with mode: 0644]
scaffold/tests/06-return-void.c [new file with mode: 0644]
scaffold/tests/08-assign-global.c [new file with mode: 0644]
scaffold/tests/08-assign-negative.c [new file with mode: 0644]
scaffold/tests/11-if-1.c
scaffold/tests/15-if-!f.c
scaffold/tests/16-if-t.c
scaffold/tests/17-compare-and-or.c [new file with mode: 0644]
scaffold/tests/17-compare-and.c [new file with mode: 0644]
scaffold/tests/17-compare-assign.c [new file with mode: 0644]
scaffold/tests/17-compare-call.c [new file with mode: 0644]
scaffold/tests/17-compare-ge.c [new file with mode: 0644]
scaffold/tests/17-compare-gt.c [new file with mode: 0644]
scaffold/tests/17-compare-le.c [new file with mode: 0644]
scaffold/tests/17-compare-lt.c [new file with mode: 0644]
scaffold/tests/17-compare-or.c [new file with mode: 0644]
scaffold/tests/17-compare-unsigned-ge.c [new file with mode: 0644]
scaffold/tests/17-compare-unsigned-gt.c [new file with mode: 0644]
scaffold/tests/17-compare-unsigned-le.c [new file with mode: 0644]
scaffold/tests/17-compare-unsigned-lt.c [new file with mode: 0644]
scaffold/tests/18-assign-shadow.c [new file with mode: 0644]
scaffold/tests/21-char[]-simple.c [new file with mode: 0644]
scaffold/tests/21-char[].c
scaffold/tests/23-global-pointer-init-null.c [new file with mode: 0644]
scaffold/tests/23-global-pointer-init.c [new file with mode: 0644]
scaffold/tests/23-global-pointer-pointer-ref.c [new file with mode: 0644]
scaffold/tests/23-global-pointer-ref.c [new file with mode: 0644]
scaffold/tests/23-pointer-sub.c [new file with mode: 0644]
scaffold/tests/23-pointer.c
scaffold/tests/31-eputs.c [deleted file]
scaffold/tests/31-oputs.c [new file with mode: 0644]
scaffold/tests/32-call-wrap.c [new file with mode: 0644]
scaffold/tests/32-compare.c
scaffold/tests/33-and-or.c
scaffold/tests/34-pre-post.c
scaffold/tests/35-compare-char.c
scaffold/tests/36-compare-arithmetic.c
scaffold/tests/37-compare-assign.c
scaffold/tests/38-compare-call-2.c [new file with mode: 0644]
scaffold/tests/38-compare-call-3.c [new file with mode: 0644]
scaffold/tests/38-compare-call.c
scaffold/tests/40-if-else.c
scaffold/tests/41-?.c
scaffold/tests/42-goto-label.c
scaffold/tests/43-for-do-while.c
scaffold/tests/44-switch-body-fallthrough.c [new file with mode: 0644]
scaffold/tests/44-switch-fallthrough.c [new file with mode: 0644]
scaffold/tests/44-switch.c
scaffold/tests/45-void-call.c
scaffold/tests/46-function-static.c
scaffold/tests/48-function-destruct.c [deleted file]
scaffold/tests/48-global-static.c [new file with mode: 0644]
scaffold/tests/49-global-static.c [deleted file]
scaffold/tests/4a-char-array.c [deleted file]
scaffold/tests/51-itoa.c [new file with mode: 0644]
scaffold/tests/51-pointer-sub.c [new file with mode: 0644]
scaffold/tests/51-strcmp.c
scaffold/tests/51-strncmp.c
scaffold/tests/52-itoa.c [deleted file]
scaffold/tests/53-strcpy.c
scaffold/tests/54-argc.c [new file with mode: 0644]
scaffold/tests/54-argv.c
scaffold/tests/55-char-array.c [new file with mode: 0644]
scaffold/tests/60-math.c
scaffold/tests/61-array.c
scaffold/tests/63-struct-array-assign.c [new file with mode: 0644]
scaffold/tests/63-struct-array-compare.c [new file with mode: 0644]
scaffold/tests/63-struct-array.c [new file with mode: 0644]
scaffold/tests/63-struct-assign.c [new file with mode: 0644]
scaffold/tests/63-struct-cell.c
scaffold/tests/63-struct-function.c [new file with mode: 0644]
scaffold/tests/63-struct-local.c [new file with mode: 0644]
scaffold/tests/63-struct-pointer.c [new file with mode: 0644]
scaffold/tests/63-struct.c [new file with mode: 0644]
scaffold/tests/64-make-cell.c
scaffold/tests/65-read.c
scaffold/tests/66-local-char-array.c
scaffold/tests/70-printf-hello.c [new file with mode: 0644]
scaffold/tests/70-printf-simple.c [new file with mode: 0644]
scaffold/tests/70-printf.c
scaffold/tests/70-stdarg.c [new file with mode: 0644]
scaffold/tests/70-strchr.c [new file with mode: 0644]
scaffold/tests/71-struct-array.c
scaffold/tests/72-typedef-struct-def.c
scaffold/tests/73-union-hello.c [new file with mode: 0644]
scaffold/tests/74-multi-line-string.c
scaffold/tests/76-pointer-arithmetic-pp.c [new file with mode: 0644]
scaffold/tests/76-pointer-arithmetic.c
scaffold/tests/79-int-array-simple.c [new file with mode: 0644]
scaffold/tests/79-int-array.c
scaffold/tests/7a-struct-char-array.c
scaffold/tests/7b-struct-int-array-hello.c [new file with mode: 0644]
scaffold/tests/7b-struct-int-array-pointer.c [new file with mode: 0644]
scaffold/tests/7b-struct-int-array.c
scaffold/tests/7i-struct-struct-simple.c [new file with mode: 0644]
scaffold/tests/7i-struct-struct.c
scaffold/tests/7k-empty-for.c [new file with mode: 0644]
scaffold/tests/7k-for-each-elem-simple.c [new file with mode: 0644]
scaffold/tests/7k-for-each-elem.c
scaffold/tests/7l-struct-any-size-array-simple.c [new file with mode: 0644]
scaffold/tests/7l-struct-any-size-array.c
scaffold/tests/7o-struct-pre-post-simple.c [new file with mode: 0644]
scaffold/tests/7o-struct-pre-post.c
scaffold/tests/7q-bit-field-simple.c [new file with mode: 0644]
scaffold/tests/7q-bit-field.c
scaffold/tests/7s-struct-short.c
scaffold/tests/7t-function-destruct.c [new file with mode: 0644]
scaffold/tests/7u-?-expression.c [new file with mode: 0644]
scaffold/tests/7u-call-?.c [new file with mode: 0644]
scaffold/tests/7u-double.c [new file with mode: 0644]
scaffold/tests/7u-inc-byte-word.c [new file with mode: 0644]
scaffold/tests/7u-long-long.c [new file with mode: 0644]
scaffold/tests/7u-struct-func.c [new file with mode: 0644]
scaffold/tests/7u-struct-size10.c [new file with mode: 0644]
scaffold/tests/7u-vstack.c [new file with mode: 0644]
scaffold/tests/80-setjmp.c
scaffold/tests/81-qsort.c
scaffold/tests/85-sizeof.c
scaffold/tests/87-sscanf.c
scaffold/tests/90-strpbrk.c
scaffold/tests/90-strspn.c [new file with mode: 0644]
scaffold/tests/91-fseek.c
scaffold/tests/95-signal.c
scaffold/tests/97-fopen.c
scaffold/tests/99-readdir.c
scaffold/tests/t.c

diff --git a/AUTHORS b/AUTHORS
index 37da1a437f5686951a283e14140ff2c21323bdcf..4e716b8f8f0b0ce470a92e7a4a78c3b604614062 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -12,11 +12,11 @@ Main author
 All files except the imported files listed below
 
 Jeremiah Orians <jeremiah@pdp10.guru>
-lib/libc+tcc.c (fopen)
+lib/stdio/fopen.c (first simple version of fopen)
 scaffold/tests/98-fopen.c
 
 Han-Wen Nienhuys <hanwen@xs4all.nl>
-lib/libc+tcc.c (_memmem, memmem)
+lib/string/memmem.c (_memmem, memmem)
 
 rain1
 scaffold/tests/90-goto-var.c
index 02ca47ab710a1ffed839e8a457751f8a5e57bfa4..650728b4f697a6bbc74d3ba3bab8adf0b6c0d5fe 100755 (executable)
@@ -53,11 +53,11 @@ ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/c
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crtn
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc-mini
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libgetopt
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc+tcc
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libtcc1
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc+gnu
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libg
+ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libgetopt
 
 LIBC= sh ${srcdest}build-aux/cc64-mes.sh scaffold/main
 LIBC=c-mini sh ${srcdest}build-aux/cc64-mes.sh scaffold/hello
index 404afe6e126cc374932cfa44092e3392eef32685..2712b87e760d1a680b2df35f12c2e943faabea57 100755 (executable)
@@ -51,11 +51,11 @@ ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crti
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crtn
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc-mini
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libgetopt
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc+tcc
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libtcc1
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc+gnu
 ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libg
+ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libgetopt
 
 LIBC= sh ${srcdest}build-aux/cc32-mes.sh scaffold/main
 LIBC=c-mini sh ${srcdest}build-aux/cc32-mes.sh scaffold/hello
index 4882dac1ae8e425a8b5c10566aea7614fbd23926..6d23c71be8e46a3bdfafd156d7ef170e4585c41f 100755 (executable)
@@ -127,9 +127,9 @@ ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/x86-mes/crti
 ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/x86-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
 ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+tcc
 ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+gnu
+ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libgetopt
 
 
 [ -n "$SEED" ] && exit 0
index c7eff73ee693a00fbb5ad4352aa09ec185265f7c..2d737b1d31904bcd3adb657bd443f53a806223eb 100755 (executable)
@@ -122,16 +122,16 @@ trace "TEST       lib/x86_64-mes/exit-42.x86_64-mes-out" echo lib/x86_64-mes/exi
 { 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-x86_64-mes.sh lib/libc-mini
+ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc
 
-# 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-x86_64-mes.sh lib/linux/x86_64-mes/crt0
+# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/linux/x86_64-mes/crti
+# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-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
-# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+tcc
-# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+gnu
+# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc+tcc
+# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc+gnu
+# ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libgetopt
 
 
 # [ -n "$SEED" ] && exit 0
@@ -146,7 +146,7 @@ trace "TEST       lib/x86_64-mes/exit-42.x86_64-mes-out" echo lib/x86_64-mes/exi
 # trace "MSNARF vector.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
 
 # echo MES_ARENA=$MES_ARENA
-# bash ${srcdest}build-aux/cc-mes.sh scaffold/main
+# bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/main
 
 MES_LIBS='-l none' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/main
 
index 4d3b6df98372183ef66fc0d5d79affb6b4b1fc97..0a5bbcda46a1cf3a633c691bcfa907bdee12ce3a 100755 (executable)
@@ -48,3 +48,4 @@ if [ -n "$TCC" ]; then
 fi
 
 sh ${srcdest}build-aux/build-mes.sh
+sh ${srcdest}build-aux/build-x86_64-mes.sh
index 8abd15bd01a722af319d1c4ebefc4978e6c0bd49..918f87d021545f72f5f5692594e55a1d41f4fecb 100755 (executable)
@@ -40,6 +40,11 @@ if ! command -v $GUILE > /dev/null; then
     GUILE=true
 fi
 
+test_sh=${test_sh-${srcdest}build-aux/test.sh}
+if [ "$arch" = "x86_64-mes" ]; then
+    test_sh=${srcdest}build-aux/test64.sh
+fi
+
 tests="
 t
 00-exit-0
@@ -49,8 +54,15 @@ t
 04-call-0
 05-call-1
 06-call-!1
+06-!call-1
+06-call-2
+06-call-string
+06-call-variable
+06-return-void
 07-include
 08-assign
+08-assign-negative
+08-assign-global
 10-if-0
 11-if-1
 12-if-==
@@ -58,53 +70,97 @@ t
 14-if-goto
 15-if-!f
 16-if-t
+17-compare-ge
+17-compare-gt
+17-compare-le
+17-compare-lt
+17-compare-unsigned-ge
+17-compare-unsigned-gt
+17-compare-unsigned-le
+17-compare-unsigned-lt
+17-compare-and
+17-compare-or
+17-compare-and-or
+17-compare-assign
+17-compare-call
+18-assign-shadow
 20-while
+21-char[]-simple
 21-char[]
 22-while-char[]
+23-global-pointer-init-null
+23-global-pointer-init
+23-global-pointer-ref
+23-global-pointer-pointer-ref
+23-pointer-sub
 23-pointer
 30-strlen
-31-eputs
+31-oputs
+32-call-wrap
 32-compare
 33-and-or
 34-pre-post
 35-compare-char
 36-compare-arithmetic
 37-compare-assign
+38-compare-call-2
+38-compare-call-3
 38-compare-call
 40-if-else
 41-?
 42-goto-label
 43-for-do-while
 44-switch
+44-switch-fallthrough
+44-switch-body-fallthrough
 45-void-call
 46-function-static
 47-function-expression
-48-function-destruct
-49-global-static
-4a-char-array
+48-global-static
 50-assert
+51-pointer-sub
+51-itoa
 51-strcmp
 51-strncmp
-52-itoa
 53-strcpy
+54-argc
 54-argv
+55-char-array
 60-math
 61-array
 62-array
+63-struct
+63-struct-pointer
+63-struct-local
+63-struct-function
+63-struct-assign
+63-struct-array
+63-struct-array-assign
+63-struct-array-compare
 63-struct-cell
 64-make-cell
 65-read
+66-local-char-array
+70-strchr
+70-stdarg
+70-printf-hello
+70-printf-simple
 70-printf
 71-struct-array
 72-typedef-struct-def
+73-union-hello
 73-union
 74-multi-line-string
 75-struct-union
+76-pointer-arithmetic-pp
 76-pointer-arithmetic
 77-pointer-assign
 78-union-struct
+79-int-array-simple
 79-int-array
 7a-struct-char-array
+7b-struct-int-array-hello
+7b-struct-int-array-pointer
 7b-struct-int-array
 7c-dynarray
 7d-cast-char
@@ -112,17 +168,33 @@ t
 7f-struct-pointer-arithmetic
 7g-struct-byte-word-field
 7h-struct-assign
+7i-struct-struct-simple
 7i-struct-struct
 7j-strtoull
+7k-empty-for
+7k-for-each-elem-simple
 7k-for-each-elem
+7l-struct-any-size-array-simple
 7l-struct-any-size-array
 7m-struct-char-array-assign
 7n-struct-struct-array
+7o-struct-pre-post-simple
 7o-struct-pre-post
 7p-struct-cast
+7q-bit-field-simple
 7q-bit-field
 7r-sign-extend
 7s-struct-short
+7s-unsigned-compare
+7t-function-destruct
+7u-double
+7u-long-long
+7u-?-expression
+7u-call-?
+7u-inc-byte-word
+7u-struct-func
+7u-struct-size10
+7u-vstack
 80-setjmp
 81-qsort
 81-qsort-dupes
@@ -133,6 +205,7 @@ t
 86-strncpy
 87-sscanf
 88-strrchr
+90-strspn
 90-strpbrk
 91-fseek
 92-stat
@@ -145,9 +218,8 @@ t
 99-readdir
 "
 
-# 90: needs GNU, fails for mescc, passes for tcc
 broken="$broken
-7s-struct-short
+66-local-char-array
 "
 
 # gcc not supported
@@ -175,7 +247,7 @@ for t in $tests; do
         LIBC=c
         MES_LIBS=
     fi
-    sh ${srcdest}build-aux/test.sh "scaffold/tests/$t" &> scaffold/tests/"$t".log
+    sh $test_sh "scaffold/tests/$t" &> scaffold/tests/"$t".log
     r=$?
     total=$((total+1))
     if [ $r = 0 ]; then
index 75ddaf5cdafa197102bee2de410070832ed8f0c3..85320597765222b3cac371455659fd04925ff102 100755 (executable)
@@ -145,8 +145,9 @@ pass=0
 fail=0
 total=0
 mkdir -p scaffold/tinycc
+set +e
 for t in $tests; do
-    if [ ! -f $TINYCC_PREFIX/"$t.c" ]; then
+    if [ ! -f $TINYCC_PREFIX/tests/tests2/"$t.c" ]; then
         echo ' [SKIP]'
         continue;
     fi
index 4d29ca4bb618fc3ee7cc48880fd3741726a4bd36..93aee8d921edfc3fa9afa6afbeb8c3fb4c9dad28 100755 (executable)
@@ -50,7 +50,7 @@ if [ -n "$CC" ]; then
     fi
 fi
 
-rm -f "$t".mes-gcc-out
+rm -f "$t".x86_64-mes-gcc-out
 if [ -n "$CC64" ]; then
     sh ${srcdest}build-aux/cc64-mes.sh "$t"
 
@@ -68,7 +68,7 @@ if [ -n "$CC64" ]; then
     fi
 fi
 
-rm -f "$o".mes-out
+rm -f "$o".x86_64-mes-out
 sh ${srcdest}build-aux/cc-x86_64-mes.sh "$t"
 
 r=0
index e7224739ecb4220d894338290ef6449825744478..1a311da554bc4ec94dca1bc1de4ba0458405cc4b 100644 (file)
@@ -39,6 +39,8 @@ int _fdungetc_p (int fd);
 int isdigit (int c);
 int isspace (int c);
 int isxdigit (int c);
+int _open3 (char const *file_name, int flags, int mask);
+int _open2 (char const *file_name, int flags);
 int oputs (char const* s);
 ssize_t write (int filedes, void const *buffer, size_t size);
 char *search_path (char const *file_name);
index fe413f8a7a3ab0ec818cba490e19583f9724f363..f2dee02564c219a46b2bf8a7ae56b15a57971e0a 100644 (file)
@@ -27,9 +27,9 @@
 
 typedef struct
 {
-  int __bp;
-  int __pc;
-  int __sp;
+  long __bp;
+  long __pc;
+  long __sp;
 } __jmp_buf;
 typedef __jmp_buf jmp_buf[1];
 
@@ -45,4 +45,3 @@ int setjmp (jmp_buf env);
 #endif // ! WITH_GLIBC
 
 #endif // __MES_SETJMP_H
-
index bd7e0404ec2e1fe2bfae9565275556ae678534bc..21079bac9291f4fbc0bf065ca6cb3084687e9b57 100644 (file)
@@ -26,8 +26,8 @@
 #else //! WITH_GLIBC
 
 
-typedef int sigset_t;
-typedef int stack_t;
+typedef long sigset_t;
+typedef long stack_t;
 
 #include <sys/types.h>
 
@@ -85,7 +85,8 @@ typedef int stack_t;
 #define SA_ONESHOT SA_RESETHAND
 
 
-typedef struct siginfo_t {
+typedef struct siginfo_t
+{
   int si_signo;
   int si_errno;
   int si_code;
@@ -113,19 +114,29 @@ typedef struct siginfo_t {
 } siginfo_t;
 
 
-typedef void (*sighandler_t)(int);
-
-struct sigaction {
-  union {
-    void (*sa_sigaction) (int signum, siginfo_t *, void *);
 #if __MESC__
-    void (*sa_handler) (int);
+typedef long sighandler_t;
 #else
-  sighandler_t sa_handler;
+typedef void (*sighandler_t)(int);
 #endif
+
+struct sigaction
+{
+  union
+  {
+    sighandler_t sa_handler;
+    void (*sa_sigaction) (int signum, siginfo_t *, void *);
   };
   unsigned long sa_flags;
+#if __x86_64__
+  long _foo0;
+#endif
   sigset_t sa_mask;
+#if __x86_64__
+  long _foo1[15];
+#endif
+  //unsigned long sa_flags; // x86?
+  void (*sa_restorer) (void);
 };
 
 
@@ -198,14 +209,14 @@ typedef struct
 
 /* Userlevel context.  */
 typedef struct ucontext
-  {
-    unsigned long int uc_flags;
-    struct ucontext *uc_link;
-    stack_t uc_stack;
-    mcontext_t uc_mcontext;
-    sigset_t uc_sigmask;
-    struct _libc_fpstate __fpregs_mem;
-  } ucontext_t;
+{
+  unsigned long int uc_flags;
+  struct ucontext *uc_link;
+  stack_t uc_stack;
+  mcontext_t uc_mcontext;
+  sigset_t uc_sigmask;
+  struct _libc_fpstate __fpregs_mem;
+} ucontext_t;
 #endif // !__i386__
 
 int kill (pid_t pid, int signum);
index 08c3815982c8e90fb9f2a98bec8f69fda17d849c..f56b0dd26aa4e3d9023a6ed746957663faeafeb3 100644 (file)
 
 #include <sys/types.h>
 
-#if __GNUC__
-typedef char* va_list;
-#define va_start(ap, last) (void)((ap) = (char*)(&(last) + 1))
-#else // !__GNUC__
-typedef int va_list;
-#define va_start(ap, last) (void)((ap) = (char*)(&(last) + 1))
-#endif // !__GNUC__
+#if __GNUC__ && __x86_64__
+#define __FOO_VARARGS 1
+#endif
 
-#define va_arg(ap, type) (type)(((int*)((ap) = ((ap) + 4)))[-1])
+typedef long va_list;
+#define va_start(ap, last) (void)((ap) = (char*)(&(last) + 1))
+#define va_arg(ap, type) (type)(((long*)((ap) = ((ap) + sizeof (void*))))[-1])
 #define va_end(ap) (void)((ap) = 0)
 #define va_copy(dest, src) dest = src
 
index c8a83cd4c265dd8c383b72087e74163d1459b0e1..17626f4130c49568d5be08719fd88e8976b7caac 100644 (file)
@@ -34,6 +34,7 @@
 typedef int mode_t;
 #endif
 
+#if __i386__
 struct stat
 {
   unsigned long  st_dev;
@@ -44,17 +45,40 @@ struct stat
   unsigned short st_gid;
   unsigned long  st_rdev;
   long           st_size;
-  unsigned int   st_blksize;
-  unsigned int   st_blocks;
+  unsigned long  st_blksize;
+  unsigned long  st_blocks;
   time_t         st_atime;
   unsigned long  st_atime_usec;
   time_t         st_mtime;
   unsigned long  st_mtime_usec;
   time_t         st_ctime;
   unsigned long  st_ctime_usec;
-  unsigned int   __foo0;
-  unsigned int   __foo1;
+  unsigned long  __foo0;
+  unsigned long  __foo1;
 };
+#elif __x86_64__
+struct stat
+{
+  unsigned long  st_dev;
+  unsigned long  st_ino;
+  unsigned int   st_mode;
+  unsigned int   st_nlink;
+  unsigned int   st_uid;
+  unsigned int   st_gid;
+  unsigned long  st_rdev;
+  long           st_size;
+  unsigned long  st_blksize;
+  unsigned long  st_blocks;
+  time_t         st_atime;
+  unsigned long  st_atime_usec;
+  time_t         st_mtime;
+  unsigned long  st_mtime_usec;
+  time_t         st_ctime;
+  unsigned long  st_ctime_usec;
+  unsigned long  __foo0;
+  unsigned long  __foo1;
+};
+#endif
 
 int chmod (char const *file_name, mode_t mode);
 int mkdir (char const *file_name, mode_t mode);
index 1e2f29a62e5da61a32b6f04af534402fcad0be31..1efde1f4f36f5b2aaa364219dcc9a3d0a07d8f97 100644 (file)
@@ -48,25 +48,25 @@ typedef long clock_t;
 #ifndef __MES_DEV_T
 #define __MES_DEV_T
 #undef dev_t
-typedef int dev_t;
+typedef long dev_t;
 #endif
 
 #if !defined (__MES_FILE_T) && ! defined (_FILE_T)
 #define __MES_FILE_T
 #define _FILE_T
-typedef int FILE;
+typedef long FILE;
 #endif
 
 #ifndef __MES_GID_T
 #define __MES_GID_T
 #undef gid_t
-typedef int gid_t;
+typedef unsigned gid_t;
 #endif
 
 #ifndef __MES_INO_T
 #define __MES_INO_T
 #undef ino_t
-typedef unsigned ino_t;
+typedef unsigned long ino_t;
 #endif
 
 #ifndef __MES_INO64_T
@@ -111,7 +111,7 @@ typedef long ptrdiff_t;
 #ifndef __MES_SIGVAL_T
 #define __MES_SIGVAL_T
 #undef clock_t
-typedef int sigval_t;
+typedef long sigval_t;
 #endif
 
 #ifndef __SIZE_T
@@ -132,7 +132,7 @@ typedef long ssize_t;
 #ifndef __MES_UID_T
 #define __MES_UID_T
 #undef uid_t
-typedef int uid_t;
+typedef unsigned uid_t;
 #endif
 
 #endif // ! WITH_GLIBC
index 0600a6e52081f51279a7c383e8a4e600cc144aea..c34584cf23ec312fe4cd37d0efc1d15aa7712da8 100644 (file)
@@ -62,7 +62,7 @@ int execve (char const *file, char *const argv[], char *const env[]);
 int execvp (char const *file, char *const argv[]);
 int fork (void);
 char *getcwd (char *buf, size_t size);
-uid_t getgid (void);
+gid_t getgid (void);
 uid_t getuid (void);
 int isatty (int fd);
 int link (char const *oldname, char const *newname);
index 35fcdd16492d2030b93cb7411b3da39ca377f3ec..a8b9a49d7272f23467b3ec2d81ce6d992368a778 100644 (file)
@@ -35,6 +35,8 @@
 
 #include <libc.c>
 
+int errno;
+
 #if __GNU__
 #include <hurd/tcc.c>
 #elif __linux__
 #error both __GNU__ and _linux__ are undefined, choose one
 #endif
 
-#if __MESC__
+#if __MESC__ && __i386__
 #include <x86-mes/setjmp.c>
+#elif __MESC__ && __x86_64__
+#include <x86_64-mes/setjmp.c>
 #elif __i386__
 #include <x86-mes-gcc/setjmp.c>
 #elif __x86_64__
index 70dd5a2f9d9e401d38377479d7b22d6b556d656f..ecc2c3dedb0bebce91dc3dfeda42ff9252da115a 100644 (file)
@@ -60,7 +60,7 @@ mkdir (char const *file_name, mode_t mode)
 int
 dup (int old)
 {
-  return _sys_call1 (SYS_dup, (long)old);
+  return _sys_call1 (SYS_dup, (int)old);
 }
 
 gid_t
@@ -69,28 +69,43 @@ getgid ()
   return _sys_call (SYS_getgid);
 }
 
-#if __i386__
-#if __MESC__
-void *
-signal (int signum, void * action)
-#else
-sighandler_t
-signal (int signum, sighandler_t action)
-#endif
+// long _sys_call (long sys_call);
+// long _sys_call4 (long sys_call, long one, long two, long three, long four);
+
+#define SA_SIGINFO 4
+#define SA_RESTORER 0x04000000
+
+#define SYS_rt_sigreturn 15
+
+void
+_restorer (void)
 {
-  return _sys_call2 (SYS_signal, signum, action);
+  _sys_call (SYS_rt_sigreturn);
 }
-#elif __x86_64__
+
+# define __sigmask(sig) \
+  (((unsigned long int) 1) << (((sig) - 1) % (8 * sizeof (unsigned long int))))
+
 sighandler_t
 signal (int signum, sighandler_t action)
 {
-  sighandler_t old;
-  _sys_call3 (SYS_rt_sigaction, signum, action, &old);
-  return old;
-}
+#if __i386__
+  return _sys_call2 (SYS_signal, signum, action);
 #else
-#error arch not supported
+  static struct sigaction setup_action = {-1};
+  static struct sigaction old = {0};
+
+  setup_action.sa_handler = action;
+  setup_action.sa_restorer = _restorer;
+  setup_action.sa_mask = __sigmask (signum);
+  old.sa_handler = SIG_DFL;
+  setup_action.sa_flags = SA_RESTORER | SA_RESTART;
+  int r = _sys_call4 (SYS_rt_sigaction, signum, &setup_action, &old, sizeof (sigset_t));
+  if (r)
+    return 0;
+  return old.sa_handler;
 #endif
+}
 
 int
 fcntl (int filedes, int command, ...)
@@ -98,7 +113,7 @@ fcntl (int filedes, int command, ...)
   va_list ap;
   va_start (ap, command);
   int data = va_arg (ap, int);
-  int r = _sys_call3 (SYS_fcntl, (long)filedes, (long)command, (long)data);
+  int r = _sys_call3 (SYS_fcntl, (int)filedes, (int)command, (int)data);
   va_end (ap);
   return r;
 }
@@ -112,13 +127,13 @@ pipe (int filedes[2])
 int
 dup2 (int old, int new)
 {
-  return _sys_call2 (SYS_dup2, (long)old, (long)new);
+  return _sys_call2 (SYS_dup2, (int)old, (int)new);
 }
 
 int
 getrusage (int processes, struct rusage *rusage)
 {
-  return _sys_call2 (SYS_getrusage, (long)processes, (long)rusage);
+  return _sys_call2 (SYS_getrusage, (int)processes, (long)rusage);
 }
 
 int
@@ -142,15 +157,15 @@ setitimer (int which, struct itimerval const *new,
 }
 
 int
-fstat (int fd, struct stat *statbuf)
+fstat (int filedes, struct stat *statbuf)
 {
-  return _sys_call2 (SYS_fstat, (long)fd, (long)statbuf);
+  return _sys_call2 (SYS_fstat, (int)filedes, (long)statbuf);
 }
 
 int
-getdents (long filedes, char *buffer, size_t nbytes)
+getdents (int filedes, char *buffer, size_t nbytes)
 {
-  return _sys_call3 (SYS_getdents, (long)filedes, (long)buffer, (long)nbytes);
+  return _sys_call3 (SYS_getdents, (int)filedes, (long)buffer, (long)nbytes);
 }
 
 int
index 05cc339fa756abad6fdbf7fc5c69cf65e00556de..d303f3bbf1cd5257b2f1b6cd69cb92dc4481c956 100644 (file)
 
 #include <errno.h>
 
-#if __MESC__
-
+#if __MESC__ && __i386__
 #include <linux/x86-mes/mini.c>
-
+#elif __MESC__ && __x86_64__
+#include <linux/x86_64-mes/mini.c>
 #elif __i386__
-
 #include <linux/x86-mes-gcc/mini.c>
-
 #elif __x86_64__
-
 #include <linux/x86_64-mes-gcc/mini.c>
-
 #else
-
 #error arch not supported
-
 #endif
 
 ssize_t
index dd4aac7f5daa827d0822963e8700bdc6c88478c5..8231a778e180cd855c4b30ba3af85f1644fde846 100644 (file)
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <libmes.h>
+
 #include <fcntl.h>
 #include <stdarg.h>
 #include <stdio.h>
-#include <libmes.h>
 #include <stdlib.h>
 #include <unistd.h>
 #include <sys/stat.h>
 #include <sys/wait.h>
 
-#if __MESC__
-
+#if __MESC__ && __i386__
 #include <linux/x86-mes/mes.c>
-
+#elif __MESC__ && __x86_64__
+#include <linux/x86_64-mes/mes.c>
 #elif __i386__
-
 #include <linux/x86-mes-gcc/mes.c>
-
 #elif __x86_64__
-
 #include <linux/x86_64-mes-gcc/mes.c>
-
 #else
-
 #error arch not supported
-
 #endif
 
 int
@@ -54,7 +49,7 @@ fork ()
 ssize_t
 read (int filedes, void *buffer, size_t size)
 {
-  ssize_t bytes = _sys_call3 (SYS_read, (long)filedes, (long)buffer, (long)size);
+  ssize_t bytes = _sys_call3 (SYS_read, (int)filedes, (long)buffer, (long)size);
   if (__mes_debug () > 3)
     {
       if (bytes == 1)
@@ -71,11 +66,8 @@ read (int filedes, void *buffer, size_t size)
 }
 
 int
-open (char const *file_name, int flags, ...)
+_open3 (char const *file_name, int flags, int mask)
 {
-  va_list ap;
-  va_start (ap, flags);
-  int mask = va_arg (ap, int);
 #if !MES_BOOTSTRAP
   if (!flags)
     {
@@ -83,7 +75,24 @@ open (char const *file_name, int flags, ...)
       _ungetc_fd = -1;
     }
 #endif
-  int r = _sys_call3 (SYS_open, (long)file_name, (long)flags, (long)mask);
+  int r = _sys_call3 (SYS_open, (long)file_name, (int)flags, (int)mask);
+  return r;
+}
+
+int
+_open2 (char const *file_name, int flags)
+{
+  int mask = 0777;
+  return _open3 (file_name, flags, mask);
+}
+
+int
+open (char const *file_name, int flags, ...)
+{
+  va_list ap;
+  va_start (ap, flags);
+  int mask = va_arg (ap, int);
+  int r = _open3 (file_name, flags, mask);
   va_end (ap);
   return r;
 }
@@ -92,9 +101,9 @@ pid_t
 waitpid (pid_t pid, int *status_ptr, int options)
 {
 #if __i386__
-  return _sys_call3 (SYS_waitpid, (long)pid, (long)status_ptr, (long)options);
+  return _sys_call3 (SYS_waitpid, (long)pid, (long)status_ptr, (int)options);
 #elif __x86_64__
-  return _sys_call4 (SYS_wait4, (long)pid, (long)status_ptr, (long)options, 0);
+  return _sys_call4 (SYS_wait4, (long)pid, (long)status_ptr, (int)options, 0);
 #else
 #error arch not supported
 #endif
@@ -115,7 +124,7 @@ chmod (char const *file_name, mode_t mask)
 int
 access (char const *file_name, int how)
 {
-  return _sys_call2 (SYS_access, (long)file_name, (long)how);
+  return _sys_call2 (SYS_access, (long)file_name, (int)how);
 }
 
 long
@@ -130,7 +139,7 @@ ioctl (int filedes, unsigned long command, ...)
   va_list ap;
   va_start (ap, command);
   int data = va_arg (ap, int);
-  int r = _sys_call3 (SYS_ioctl, (long)filedes, (long)command, (long)data);
+  int r = _sys_call3 (SYS_ioctl, (int)filedes, (long)command, (int)data);
   va_end (ap);
   return r;
 }
@@ -138,5 +147,5 @@ ioctl (int filedes, unsigned long command, ...)
 int
 fsync (int filedes)
 {
-  return _sys_call1 (SYS_fsync, (long)filedes);
+  return _sys_call1 (SYS_fsync, (int)filedes);
 }
index 59c2128d064527e30611555f0d8edecefacbc893..f912db8a6bf5f09f6187c0d269af9f7611f3c13f 100644 (file)
@@ -28,13 +28,13 @@ close (int filedes)
       _ungetc_pos = -1;
       _ungetc_fd = -1;
     }
-  return _sys_call1 (SYS_close, (long)filedes);
+  return _sys_call1 (SYS_close, (int)filedes);
 }
 
 off_t
 lseek (int filedes, off_t offset, int whence)
 {
-  return _sys_call3 (SYS_lseek, (long)filedes, (long)offset, (long)whence);
+  return _sys_call3 (SYS_lseek, (int)filedes, (long)offset, (int)whence);
 }
 
 int
index 1e9c97915ecb15607ebb40225356bed68434362c..0b9cc182ae95b0be9731ac4ed0073d8d49edf5ce 100644 (file)
@@ -19,7 +19,7 @@
  */
 
 char **environ = 0;
-int main (int argc, char *argv[], char *envp[]);
+//int main (int argc, char *argv[], char *envp[]);
 
 void
 _start ()
index e1c6619c44454fd5fb73a37629c63c89765831c8..a1be28ee5901daee7b0d5fb320443fb7cc7ef898 100644 (file)
@@ -19,7 +19,7 @@
  */
 
 char **environ = 0;
-int main (int argc, char *argv[]);
+// int main (int argc, char *argv[]);
 
 // gcc x86_64 calling convention:
 // rdi, rsi, rdx, rcx, r8, r9, <stack0>, <stack1>
index 27dc56f6d75e121307324309d8f91e5de6874078..5e4d6b9e6dfbe17d3c3e26fa2488ebbd95dda7f7 100644 (file)
@@ -130,13 +130,15 @@ _sys_call4 (long sys_call, long one, long two, long three, long four)
        "mov     %2,%%rdi\n\t"
        "mov     %3,%%rsi\n\t"
        "mov     %4,%%rdx\n\t"
-       "mov     %5,%%rcx\n\t"
+       "mov     %5,%%r10\n\t"
        "mov     %1,%%rax\n\t"
+  //      );
+  // asm (
        "syscall \n\t"
        "mov     %%rax,%0\n\t"
        : "=r" (r)
        : "rm" (sys_call), "rm" (one), "rm" (two), "rm" (three), "rm" (four)
-       : "rax", "rdi", "rsi", "rdx", "rcx"
+       : "rax", "rdi", "rsi", "rdx", "r10"
        );
   if (r < 0)
     {
index a63c8bee48b39ce2dca6b97daa6c87cb72a72910..fc33fdd9b87bca65355afa28c3b23eebb4110ad1 100644 (file)
@@ -24,6 +24,9 @@ int main (int argc, char *argv[]);
 int
 _start ()
 {
+#if 0 //MES_CCAMD64
+  asm ("add____$i32,%rbp %0x80"); // FIXME: corresponds to x86_64/as.scm function-preamble-fu
+#endif
   asm ("mov____%rbp,%rax");
   asm ("add____$i8,%rax !8");
 
@@ -33,23 +36,32 @@ _start ()
   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");
+  // FIXME: 64-bit addresses...
+  asm ("mov____%rax,0x32 &environ");
+#if 0 //MES_CCAMD64
+  asm ("mov____%rax,%rdx");     // amd
+#else
+  asm ("push___%rax");          // bootstrap
+#endif
 
   asm ("mov____%rbp,%rax");
   asm ("add____$i8,%rax !16");
-  asm ("mov____%rax,%rsi");
+#if 0 //MES_CCAMD64
+  asm ("mov____%rax,%rsi");     // amd
+#else
+  asm ("push___%rax");          // bootstrap
+#endif
 
   asm ("mov____%rbp,%rax");
   asm ("add____$i8,%rax !8");
   asm ("mov____(%rax),%rax");
-  asm ("mov____%rax,%rdi");
+#if 0 //MES_CCAMD64
+  asm ("mov____%rax,%rdi");     // amd
+#else
+  asm ("push___%rax");          // bootstrap
+#endif
 
   main ();
-  // FIXME
-  //asm ("call32 &main !00 !00 !00 !00");
 
   asm ("mov____%rax,%rdi");
   asm ("mov____$i32,%rax %0x3c");
diff --git a/lib/linux/x86_64-mes/mes.c b/lib/linux/x86_64-mes/mes.c
new file mode 100644 (file)
index 0000000..e87656b
--- /dev/null
@@ -0,0 +1,123 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,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/>.
+ */
+
+#include <errno.h>
+#include <linux/x86_64/syscall.h>
+
+long
+//__sys_call (long one, long two, long three, long four)
+__sys_call (long sys_call, long one, long two, long three, long four)
+{
+#if 1 // !MES_CCAMD64
+  // asm ("mov____0x8(%rbp),%rdi !0x10");
+  // asm ("mov____0x8(%rbp),%rsi !0x18");
+  // asm ("mov____0x8(%rbp),%rdx !0x20");
+  // asm ("mov____0x8(%rbp),%rdx !0x28");
+  // asm ("mov____0x8(%rbp),%r10 !0x30");
+
+  asm ("mov____0x8(%rbp),%rax !0x10");
+  asm ("mov____0x8(%rbp),%rdi !0x18");
+  asm ("mov____0x8(%rbp),%rsi !0x20");
+  asm ("mov____0x8(%rbp),%rdx !0x28");
+  asm ("mov____0x8(%rbp),%r10 !0x30");
+#endif
+
+  asm ("syscall");
+}
+
+long
+_sys_call (long sys_call)
+{
+  // long rax = sys_call;
+  // long r = __sys_call ();
+  long r = __sys_call (sys_call);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+long
+_sys_call1 (long sys_call, long one)
+{
+  // long rax = sys_call;
+  // long r = __sys_call (one);
+  long r = __sys_call (sys_call, one);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+long
+_sys_call2 (long sys_call, long one, long two)
+{
+  // long rax = sys_call;
+  // long r = __sys_call (one, two);
+  long r = __sys_call (sys_call, one, two);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+long
+_sys_call3 (long sys_call, long one, long two, long three)
+{
+  // long rax = sys_call;
+  // long r = __sys_call (one, two, three);
+  long r = __sys_call (sys_call, one, two, three);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
+
+long
+_sys_call4 (long sys_call, long one, long two, long three, long four)
+{
+  // long rax = sys_call;
+  // long r = __sys_call (one, two, three, four);
+  long r = __sys_call (sys_call, one, two, three, four);
+  if (r < 0)
+    {
+      errno = -r;
+      r = -1;
+    }
+  else
+    errno = 0;
+  return r;
+}
diff --git a/lib/linux/x86_64-mes/mini.c b/lib/linux/x86_64-mes/mini.c
new file mode 100644 (file)
index 0000000..c581672
--- /dev/null
@@ -0,0 +1,43 @@
+/* -*-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/>.
+ */
+
+void
+_exit (int status)
+{
+#if 1 // !MES_CCAMD64
+  asm ("mov____0x8(%rbp),%rdi !0x10");
+#endif
+
+  asm ("mov____$i32,%rax SYS_exit");
+  asm ("syscall");
+}
+
+void
+_write (int filedes, void const *buffer, size_t size)
+{
+#if 1 // !MES_CCAMD64
+  asm ("mov____0x8(%rbp),%rdi !0x10");
+  asm ("mov____0x8(%rbp),%rsi !0x18");
+  asm ("mov____0x8(%rbp),%rdx !0x20");
+#endif
+
+  asm ("mov____$i32,%rax SYS_write");
+  asm ("syscall");
+}
index bf0ba9c1c716aca80426e3d72aa8d0dde9816ae5..69ec50a634ca0d618187e758031510555698f5b5 100644 (file)
@@ -26,7 +26,8 @@ abtol (char const **p, int base)
   char const *s = *p;
   int i = 0;
   int sign = 1;
-  if (!base) base = 10;
+  if (!base)
+    base = 10;
   if (*s && *s == '-')
     {
       sign = -1;
index 256db921f581d2ffb6640b535fd80dd4dbb4886a..0c7e5164aec04f2d554269c1146efb01eafb175b 100644 (file)
@@ -24,7 +24,7 @@ char *
 mktemp (char *template)
 {
   char *p = strchr (template, '\0');
-  int q = (int)template;
+  int q = (long)template;
   *--p = ((unsigned char)(q >> 4)) % 26 + 'a';
   *--p = ((unsigned char)(q >> 8)) % 26 + 'a';
   *--p = ((unsigned char)(q >> 12)) % 26 + 'a';
index 5d1d6f4083888ff70ed810dd8ec9c8524a3a62b6..a9bb1f4c0eed1ab1f13d9ad69eef28842bd4c9a4 100644 (file)
@@ -20,7 +20,7 @@
 
 #include <sys/wait.h>
 
-int
+pid_t
 wait (int *status_ptr)
 {
   return waitpid  (-1, status_ptr, 0);
index b0227a01b635e3484b73929bec1048235ad4906d..2a73ddd38c47d345150b1d2c8be3e79be47a4344 100644 (file)
 #include <libmes.h>
 #include <stdio.h>
 
+//#if __GNUC__ && __x86_64__
+#if __x86_64__
+#undef open
+#define open _open3
+#endif
+
 FILE*
 fopen (char const *file_name, char const *opentype)
 {
@@ -64,3 +70,5 @@ fopen (char const *file_name, char const *opentype)
     fd = 0;
   return (FILE*)fd;
 }
+
+#undef open
index bcadbc3fe8ed0102aec6eedd563fac4b801ff209..264a2af35c48d606c317f358515a72a94a99ed8d 100644 (file)
@@ -23,5 +23,5 @@
 int
 fputc (int c, FILE* stream)
 {
-  return fdputc (c, (long)stream);
+  return fdputc (c, (int)stream);
 }
index 91e687c2caa1062e6999e07141695061a3ecc970..f53c7b725406fc87f743dd7f295f584519b87a34 100644 (file)
@@ -24,7 +24,7 @@
 int
 fseek (FILE *stream, long offset, int whence)
 {
-  int pos = lseek ((int)stream, offset, whence);
+  off_t pos = lseek ((int)stream, offset, whence);
   if (__mes_debug ())
     {
       eputs ("fread fd="); eputs (itoa ((int)stream));
index f9787ab8d5a04bca6582eed5b7c666d3a99094c4..95ad3d4eca712f528397f8f56ec82a21afa671fd 100644 (file)
@@ -25,8 +25,14 @@ int
 printf (char const* format, ...)
 {
   va_list ap;
+  int r;
+#if __GNUC__ && __x86_64__
+#define __FUNCTION_ARGS 1
+  ap += (__FOO_VARARGS + (__FUNCTION_ARGS << 1)) << 3;
+#undef __FUNCTION_ARGS
+#endif
   va_start (ap, format);
-  int r = vprintf (format, ap);
+  r = vprintf (format, ap);
   va_end (ap);
   return r;
 }
index 2cc90a172f7855c96eaecb3270f1a1565a64d207..5edf9306e4956f8f3a70147578fa1cf4d725524b 100644 (file)
@@ -25,8 +25,14 @@ int
 sprintf (char *str, char const* format, ...)
 {
   va_list ap;
+  int r;
+#if __GNUC__ && __x86_64__
+#define __FUNCTION_ARGS 2
+  ap += (__FOO_VARARGS + (__FUNCTION_ARGS << 1)) << 3;
+#undef __FUNCTION_ARGS
+#endif
   va_start (ap, format);
-  int r = vsprintf (str, format, ap);
+  r = vsprintf (str, format, ap);
   va_end (ap);
   return r;
 }
index 57cf079b9bf2fd43a630740e0c86a6579260c1d7..1e3cc3eabed46efb9474a949f34b0df70c04c957 100644 (file)
@@ -25,7 +25,7 @@
 int
 vfprintf (FILE* f, char const* format, va_list ap)
 {
-  int fd = (int)f;
+  int fd = (long)f;
   char const *p = format;
   int count = 0;
   while (*p)
@@ -85,8 +85,19 @@ vfprintf (FILE* f, char const* format, va_list ap)
           }
         switch (c)
           {
-          case '%': {fputc (*p, fd); count++; break;}
-          case 'c': {char c; c = va_arg (ap, int); fputc (c, fd); break;}
+          case '%':
+            {
+              fputc (*p, fd);
+              count++;
+              break;
+            }
+          case 'c':
+            {
+              char _c;
+              _c = va_arg (ap, long);
+              fputc (_c, fd);
+              break;
+            }
           case 'd':
           case 'i':
           case 'o':
@@ -94,7 +105,7 @@ vfprintf (FILE* f, char const* format, va_list ap)
           case 'x':
           case 'X':
             {
-              int d = va_arg (ap, int);
+              long d = va_arg (ap, long);
               int base = c == 'o' ? 8
                 : c == 'x' || c == 'X' ? 16
                 : 10;
index 2194f68e68299caad3d880c1dd861f3ecabf56ef..41147db8a4826e9de83676f145aecc86d2d995dc 100644 (file)
@@ -57,7 +57,7 @@ vsprintf (char *str, char const* format, va_list ap)
           }
         else if (c == '*')
           {
-            width = va_arg (ap, int);
+            width = va_arg (ap, long);
             c = *++p;
           }
         if (c == '.')
@@ -70,7 +70,7 @@ vsprintf (char *str, char const* format, va_list ap)
               }
             else if (c == '*')
               {
-                precision = va_arg (ap, int);
+                precision = va_arg (ap, long);
                 c = *++p;
               }
           }
@@ -85,8 +85,19 @@ vsprintf (char *str, char const* format, va_list ap)
           }
         switch (c)
           {
-          case '%': {*str++ = *p; count++; break;}
-          case 'c': {c = va_arg (ap, int); *str++ = c; count++; break;}
+          case '%':
+            {
+              *str++ = *p;
+              count++;
+              break;
+            }
+          case 'c':
+            {
+              c = va_arg (ap, long);
+              *str++ = c;
+              count++;
+              break;
+            }
           case 'd':
           case 'i':
           case 'o':
@@ -94,7 +105,7 @@ vsprintf (char *str, char const* format, va_list ap)
           case 'x':
           case 'X':
             {
-              int d = va_arg (ap, int);
+              long d = va_arg (ap, long);
               int base = c == 'o' ? 8
                 : c == 'x' || c == 'X' ? 16
                 : 10;
index 9f2568a862658a32a4c764099b057a6f38cf492e..e1604448b3d3efbf39ce4c22453915921e985916 100644 (file)
@@ -41,7 +41,11 @@ vsscanf (char const *s, char const *template, va_list ap)
           c = *++t;
         switch (c)
           {
-          case '%': {p++; break;}
+          case '%':
+            {
+              p++;
+              break;
+            }
           case 'c':
             {
               char *c = va_arg (ap, char*);
index 22f493e228e9165835f215f914e7f40c883e4c52..237f121da2ad58a431bf8c4473c9195f6eb42dfe 100644 (file)
@@ -40,7 +40,13 @@ qpart (void *base, size_t count, size_t size, int (*compare)(void const *, void
       int c = compare (base+j*size, p);
       if (c < 0)
         {
+#if 1 //__x86_64__
           qswap (base+i*size, base+j*size, size);
+#else
+          int p1 = base+i*size;
+          int p2 = base+j*size;
+          qswap (p1, p2, size);
+#endif
           i++;
         }
       else if (c == 0)
@@ -58,6 +64,12 @@ qsort (void *base, size_t count, size_t size, int (*compare)(void const *, void
     {
       int p = qpart (base, count-1, size, compare);
       qsort (base, p, size, compare);
+#if 1 //__x86_64__
       qsort (base+p*size, count-p, size, compare);
+#else
+      int p1 = base+p*size;
+      int p2 = count-p;
+      qsort (p1, p2, size, compare);
+#endif
     }
 }
index 050e227ae60597d6dbde49c5d9b3ae499751aeb6..3643b4640d82799c9d0648a6163e30a457026d72 100644 (file)
  */
 
 #include <setjmp.h>
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
-#include <signal.h>
-#include <sys/mman.h>
-#include <sys/time.h>
-#include <unistd.h>
-
-int errno;
 
 void
 longjmp (jmp_buf env, int val)
 {
   val = val == 0 ? 1 : val;
-  asm ("mov    0xc(%ebp),%eax\n\t"     // val
-       "mov    0x8(%ebp),%ebp\n\t"     // env*
+  asm ("mov    0x8(%ebp),%ebp\n\t"     // env*
 
        "mov    0x4(%ebp),%ebx\n\t"     // env->__pc
        "mov    0x8(%ebp),%esp\n\t"     // env->__sp
@@ -47,30 +35,12 @@ longjmp (jmp_buf env, int val)
   exit (42);
 }
 
-#if 0
-int
-setjmp_debug (jmp_buf env, int val)
-{
-  int i;
-#if 1
-  i = env->__bp;
-  i = env->__pc;
-  i = env->__sp;
-#else
-  i = env[0].__bp;
-  i = env[0].__pc;
-  i = env[0].__sp;
-#endif
-  return val == 0 ? 1 : val;
-}
-#endif
-
 int
 setjmp (jmp_buf env)
 {
-  int *p = (int*)&env;
+  long *p = (long*)&env;
   env[0].__bp = p[-2];
   env[0].__pc = p[-1];
-  env[0].__sp = (int)&env;
+  env[0].__sp = (long)&env;
   return 0;
 }
index 99bdd303d443ce007072c08a75a4291662a0ff32..db3dc4a322cc971943c0e704d3143bdaf1429e8a 100644 (file)
  */
 
 #include <setjmp.h>
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
-#include <signal.h>
-#include <sys/mman.h>
-#include <sys/time.h>
-#include <unistd.h>
-
-int errno;
 
 void
 longjmp (jmp_buf env, int val)
 {
   val = val == 0 ? 1 : val;
-  asm ("mov____0x8(%ebp),%eax !0x0c"); // val
+  ///asm ("mov____0x8(%ebp),%eax !0x0c"); // val
   asm ("mov____0x8(%ebp),%ebp !0x08"); // env*
 
   asm ("mov____0x8(%ebp),%ebx !0x4");  // env.__pc
@@ -46,28 +35,10 @@ longjmp (jmp_buf env, int val)
   exit (42);
 }
 
-#if 0
-int
-setjmp_debug (jmp_buf env, int val)
-{
-  int i;
-#if 1
-  i = env->__bp;
-  i = env->__pc;
-  i = env->__sp;
-#else
-  i = env[0].__bp;
-  i = env[0].__pc;
-  i = env[0].__sp;
-#endif
-  return val == 0 ? 1 : val;
-}
-#endif
-
 int
 setjmp (__jmp_buf *env)
 {
-  int *p = (int*)&env;
+  long *p = (long*)&env;
   env[0].__bp = p[-2];
   env[0].__pc = p[-1];
   env[0].__sp = (long)&env;
index 978f330917af01683e45899baa6642747272bed5..937191a3d9649e559c722d4549391cdd57be9f78 100644 (file)
@@ -1,5 +1,5 @@
 ### GNU Mes --- Maxwell Equations of Software
-### Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+### Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ###
 ### This file is part of GNU Mes.
 ###
 ### You should have received a copy of the GNU General Public License
 ### along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+# reduced instruction set: eax, ebx (some ecx for shift, edx for mul, div)
+# 182 instructions
 DEFINE add____$i32,%eax 05
-DEFINE add____$i32,%ecx 81c1
-DEFINE add____$i32,%edx 81c2
+DEFINE add____$i32,%ebx 81c3
 DEFINE add____$i32,(%eax) 8100
+DEFINE add____$i32,(%ebx) 8103
 DEFINE add____$i32,0x32(%eax) 8180
 DEFINE add____$i32,0x32(%ebp) 8185
 DEFINE add____$i8,%eax 83c0
-DEFINE add____$i8,%edx 83c2
+DEFINE add____$i8,%ebx 83c3
 DEFINE add____$i8,%esp 83c4
 DEFINE add____$i8,(%eax) 8300
+DEFINE add____$i8,(%ebx) 8303
 DEFINE add____$i8,0x32 8305
 DEFINE add____$i8,0x32(%eax) 8380
-DEFINE add____$i8,0x32(%eax) 8380
 DEFINE add____$i8,0x32(%ebp) 8385
 DEFINE add____$i8,0x8(%eax) 8340
 DEFINE add____$i8,0x8(%ebp) 8345
 DEFINE add____%eax,%eax 01c0
 DEFINE add____%ebp,%eax 01e8
-DEFINE add____%edx,%eax 01d0
-DEFINE add____%edx,%eax 01d0
+DEFINE add____%ebx,%eax 01d8
+DEFINE add____%ebx,%ebx 01db
+DEFINE addb___$i8,(%eax) 8000
+DEFINE addb___$i8,(%ebx) 8003
+DEFINE addw___$i8,(%eax) 668100
+DEFINE addw___$i8,(%ebx) 668103
 DEFINE and____$i32,%eax 25
-DEFINE and____%edx,%eax 21d0
-DEFINE and____(%edx),%eax 2302
+DEFINE and____$i32,%ebx 81e3
+DEFINE and____%ebx,%eax 21d8
 DEFINE call32 e8
 DEFINE call___*%eax ffd0
+DEFINE call___*%ebx ffd3
 DEFINE cmp____$0x32,%eax 3d
 DEFINE cmp____$i32,%eax 3d
-DEFINE cmp____$i32,0x32(%ebp) 81bd
-DEFINE cmp____$i32,0x8(%ebp) 817d
 DEFINE cmp____$i8,%eax 83f8
-DEFINE cmp____$i8,0x32(%ebp) 83bd
-DEFINE cmp____$i8,0x8(%ebp) 837d
-DEFINE cmp____%al,%dl 38c2
-DEFINE cmp____%edx,%eax 39d0
 DEFINE hlt f4
 DEFINE idiv___%ebx f7fb
 DEFINE int cd
@@ -69,104 +70,86 @@ DEFINE jmp____*%ebx ffe3
 DEFINE jne32 0f85
 DEFINE lahf 9f
 DEFINE lea____0x32(%ebp),%eax 8d85
-DEFINE lea____0x32(%ebp),%edx 8d95
 DEFINE lea____0x8(%ebp),%eax 8d45
-DEFINE lea____0x8(%ebp),%edx 8d55
 DEFINE leave c9
 DEFINE mov____$i32,%eax b8
 DEFINE mov____$i32,%ebx bb
-DEFINE mov____$i32,%ecx b9
-DEFINE mov____$i32,%edx ba
 DEFINE mov____$i32,(%eax) c700
 DEFINE mov____$i32,0x32 c705
 DEFINE mov____$i32,0x8(%eax) c740
 DEFINE mov____$i32,0x8(%ebp) c745
-DEFINE mov____%al,(%edx) 8802
-DEFINE mov____%al,0x8(%edx) 8842
-DEFINE mov____%ax,(%edx) 668902
-DEFINE mov____%ax,0x32(%edx) 668982
-DEFINE mov____%ax,0x8(%edx) 668942
+DEFINE mov____%al,(%ebx) 8803
+DEFINE mov____%al,0x8(%ebp) 8845
+DEFINE mov____%ax,(%ebx) 668903
+DEFINE mov____%ax,0x8(%ebp) 668945
 DEFINE mov____%dl,(%eax) 8810
 DEFINE mov____%dl,0x8(%eax) 8850
 DEFINE mov____%eax,%ebx 89c3
-DEFINE mov____%eax,%edx 89c2
-DEFINE mov____%eax,(%ecx) 8901
-DEFINE mov____%eax,(%edx) 8902
+DEFINE mov____%eax,%ecx 89c1
+DEFINE mov____%eax,(%ebx) 8903
 DEFINE mov____%eax,0x32 a3
 DEFINE mov____%eax,0x32(%ebp) 8985
-DEFINE mov____%eax,0x32(%edx) 8982
 DEFINE mov____%eax,0x8(%ebp) 8945
-DEFINE mov____%eax,0x8(%edx) 8942
 DEFINE mov____%ebp,%eax 89e8
-DEFINE mov____%ebp,%ecx 89e9
-DEFINE mov____%ebp,%edx 89ea
+DEFINE mov____%ebp,%ebx 89eb
+DEFINE mov____%ebx,%eax 89d8
+DEFINE mov____%ebx,%ecx 89d9
 DEFINE mov____%ebx,0x32 891d
 DEFINE mov____%ebx,0x32(%ebp) 899d
 DEFINE mov____%ebx,0x8(%ebp) 895d
-DEFINE mov____%ebx,0x8(%edx) 895a
-DEFINE mov____%ecx,(%eax) 8908
-DEFINE mov____%ecx,(%edx) 890a
-DEFINE mov____%ecx,0x32(%ebp) 898d
-DEFINE mov____%ecx,0x8(%ebp) 894d
+DEFINE mov____%ecx,(%ebx) 890b
 DEFINE mov____%edx,%eax 89d0
 DEFINE mov____%edx,%ebx 89d3
-DEFINE mov____%edx,%ecx 89d1
-DEFINE mov____%edx,(%eax) 8910
-DEFINE mov____%edx,0x32(%ebp) 8995
-DEFINE mov____%edx,0x8(%ebp) 8955
 DEFINE mov____%esp,%ebp 89e5
 DEFINE mov____(%eax),%eax 8b00
 DEFINE mov____(%eax),%ecx 8b08
-DEFINE mov____(%edx),%eax 8b02
-DEFINE mov____(%edx),%ecx 8b0a
-DEFINE mov____(%edx),%edx 8b12
+DEFINE mov____(%ebx),%ebx 8b1b
 DEFINE mov____0x32(%eax),%eax 8b80
 DEFINE mov____0x32(%eax),%ebx 8b98
-DEFINE mov____0x32(%eax),%ecx 8b88
-DEFINE mov____0x32(%ebp),%eax 8b85
 DEFINE mov____0x32(%ebp),%eax 8b85
 DEFINE mov____0x32(%ebp),%ebx 8b9d
-DEFINE mov____0x32(%ebp),%ecx 8b8d
-DEFINE mov____0x32(%ebp),%edx 8b95
-DEFINE mov____0x32(%ebp),%edx 8b95
 DEFINE mov____0x32,%eax a1
-DEFINE mov____0x32,%edx 8b15
+DEFINE mov____0x32,%ebx 8b1d
 DEFINE mov____0x8(%eax),%eax 8b40
 DEFINE mov____0x8(%eax),%ebx 8b58
-DEFINE mov____0x8(%eax),%ecx 8b48
 DEFINE mov____0x8(%ebp),%eax 8b45
 DEFINE mov____0x8(%ebp),%ebp 8b6d
 DEFINE mov____0x8(%ebp),%ebx 8b5d
 DEFINE mov____0x8(%ebp),%ecx 8b4d
+DEFINE mov____0x8(%ebp),%edi 8b7d
 DEFINE mov____0x8(%ebp),%edx 8b55
 DEFINE mov____0x8(%ebp),%esi 8b75
 DEFINE mov____0x8(%ebp),%esp 8b65
 DEFINE movsbl_%al,%eax 0fbec0
+DEFINE movsbl_%bl,%ebx 0fbedb
 DEFINE movswl_%ax,%eax 0fbfc0
+DEFINE movswl_%bx,%ebx 0fbfdb
 DEFINE movzbl_%al,%eax 0fb6c0
-DEFINE movzbl_%al,%eax 0fb6c0
-DEFINE movzbl_%dl,%edx 0fb6d2
+DEFINE movzbl_%bl,%ebx 0fb6db
 DEFINE movzbl_(%eax),%eax 0fb600
-DEFINE movzbl_(%eax),%edx 0fb610
-DEFINE movzbl_(%edx),%edx 0fb612
+DEFINE movzbl_(%ebx),%ebx 0fb61b
 DEFINE movzbl_0x32(%eax),%eax 0fb680
 DEFINE movzbl_0x8(%eax),%eax 0fb640
 DEFINE movzbl_0x8(%ebp),%eax 0fb645
 DEFINE movzwl_%ax,%eax 0fb7c0
 DEFINE movzwl_(%eax),%eax 0fb700
+DEFINE movzwl_(%ebx),%ebx 0fb71b
 DEFINE movzwl_0x32(%eax),%eax 0fb780
 DEFINE movzwl_0x32(%ebp),%eax 0fb785
 DEFINE movzwl_0x8(%eax),%eax 0fb740
-DEFINE mul____%edx f7e2
+DEFINE mul____%ebx f7e3
+DEFINE mul_____%ebx f7e3
 DEFINE nop 90
 DEFINE not____%eax f7d0
-DEFINE or_____%edx,%eax 09d0
-DEFINE or_____(%edx),%eax 0b02
+DEFINE not____%ebx f7d3
+DEFINE or_____%ebx,%eax 09d8
 DEFINE pop____%eax 58
+DEFINE pop____%ebx 5b
 DEFINE pop____%edx 5a
 DEFINE push___$i32 68
 DEFINE push___%eax 50
 DEFINE push___%ebp 55
+DEFINE push___%ebx 53
 DEFINE push___%edx 52
 DEFINE push___(%eax) ff30
 DEFINE push___0x32(%ebp) ffb5
@@ -174,36 +157,154 @@ DEFINE push___0x8(%ebp) ff75
 DEFINE ret c3
 DEFINE sahf 9e
 DEFINE seta___%al 0f97c0
+DEFINE seta___%bl 0f97c3
 DEFINE setae__%al 0f93c0
+DEFINE setae__%bl 0f93c3
 DEFINE setb___%al 0f92c0
+DEFINE setb___%bl 0f92c3
 DEFINE setbe__%al 0f96c0
+DEFINE setbe__%bl 0f96c3
 DEFINE sete___%al 0f94c0
+DEFINE sete___%bl 0f94c3
 DEFINE setg___%al 0f9fc0
+DEFINE setg___%bl 0f9fc3
 DEFINE setge__%al 0f9dc0
+DEFINE setge__%bl 0f9dc3
 DEFINE setl___%al 0f9cc0
+DEFINE setl___%bl 0f9cc3
 DEFINE setle__%al 0f9ec0
+DEFINE setle__%bl 0f9ec3
 DEFINE setne__%al 0f95c0
+DEFINE setne__%bl 0f95c3
 DEFINE shl____$i8,%eax c1e0
+DEFINE shl____$i8,%ebx c1e3
 DEFINE shl____%cl,%eax d3e0
+DEFINE shl____%cl,%ebx d3e3
 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____%ebx,%eax 29d8
 DEFINE test___%al,%al 84c0
 DEFINE test___%eax,%eax 85c0
+DEFINE test___%ebx,%ebx 85db
+DEFINE xchg___%eax,%ebx 93
 DEFINE xchg___%eax,(%esp) 870424
+DEFINE xchg___%eax,(%esp) 870424
+DEFINE xchg___%ebx,(%esp) 871c24
 DEFINE xor____$i32,%eax 35
 DEFINE xor____$i8,%ah 80f4
 DEFINE xor____%eax,%eax 31c0
+DEFINE xor____%ebx,%eax 31d8
 DEFINE xor____%ebx,%ebx 31db
-DEFINE xor____%ecx,%ecx 31c9
-DEFINE xor____%edx,%eax 31d0
 DEFINE xor____%edx,%edx 31d2
 
+
+# Enough for all of Mes + Mes C Libray when using all registers, i.e.,
+# non-reduced instruction set
+#DEFINE add____$i32,%ecx 81c1
+#DEFINE add____$i32,%edx 81c2
+#DEFINE add____$i32,%esi 81c6
+#DEFINE add____$i8,%ecx 83c1
+#DEFINE add____$i8,%edx 83c2
+#DEFINE add____$i8,%esi 83c6
+#DEFINE add____$i8,(%ecx) 8301
+#DEFINE add____$i8,(%edx) 8302
+#DEFINE add____%ecx,%ebx 01cb
+#DEFINE add____%ecx,%ecx 01c9
+#DEFINE add____%edx,%eax 01d0
+#DEFINE add____%edx,%ecx 01d1
+#DEFINE add____%edx,%edx 01d2
+#DEFINE add____%esi,%edx 01f2
+#DEFINE and____$i32,%ecx 81e1
+#DEFINE and____$i32,%edx 81e2
+#DEFINE and____%edx,%eax 21d0
+#DEFINE and____(%edx),%eax 2302
+#DEFINE cmp____%edx,%eax 39d0
+#DEFINE idiv___%ecx f7f9
+#DEFINE lea____0x32(%ebp),%edx 8d95
+#DEFINE lea____0x8(%ebp),%edx 8d55
+#DEFINE mov____$i32,%ecx b9
+#DEFINE mov____$i32,%edx ba
+#DEFINE mov____$i32,%esi be
+#DEFINE mov____%al,(%edx) 8802
+#DEFINE mov____%al,0x8(%edx) 8842
+#DEFINE mov____%ax,(%edx) 668902
+#DEFINE mov____%ax,0x32(%edx) 668982
+#DEFINE mov____%ax,0x8(%edx) 668942
+#DEFINE mov____%bl,(%ecx) 8819
+#DEFINE mov____%eax,%edx 89c2
+#DEFINE mov____%eax,%esi 89c6
+#DEFINE mov____%eax,(%ecx) 8901
+#DEFINE mov____%eax,(%edx) 8902
+#DEFINE mov____%eax,0x32(%edx) 8982
+#DEFINE mov____%eax,0x8(%edx) 8942
+#DEFINE mov____%ebp,%ecx 89e9
+#DEFINE mov____%ebp,%edx 89ea
+#DEFINE mov____%ebp,%esi 89ee
+#DEFINE mov____%ebx,(%ecx) 8919
+#DEFINE mov____%ebx,0x8(%edx) 895a
+#DEFINE mov____%ecx,%eax 89c8
+#DEFINE mov____%ecx,%ecx 89c9
+#DEFINE mov____%ecx,%edx 89ca
+#DEFINE mov____%ecx,(%eax) 8908
+#DEFINE mov____%ecx,(%edx) 890a
+#DEFINE mov____%ecx,0x32(%ebp) 898d
+#DEFINE mov____%ecx,0x8(%ebp) 894d
+#DEFINE mov____%edi,%ebx 89fb
+#DEFINE mov____%edx,%ecx 89d1
+#DEFINE mov____%edx,(%eax) 8910
+#DEFINE mov____%edx,0x32(%ebp) 8995
+#DEFINE mov____%edx,0x8(%ebp) 8955
+#DEFINE mov____%esi,%eax 89f0
+#DEFINE mov____%esi,%ebx 89f3
+#DEFINE mov____(%ecx),%ecx 8b09
+#DEFINE mov____(%edx),%eax 8b02
+#DEFINE mov____(%edx),%ecx 8b0a
+#DEFINE mov____(%edx),%edx 8b12
+#DEFINE mov____0x32(%eax),%ecx 8b88
+#DEFINE mov____0x32(%ebp),%ecx 8b8d
+#DEFINE mov____0x32(%ebp),%edx 8b95
+#DEFINE mov____0x32,%ecx 8b0d
+#DEFINE mov____0x32,%edx 8b15
+#DEFINE mov____0x8(%eax),%ecx 8b48
+#DEFINE movsbl_%cl,%ecx 0fbec9
+#DEFINE movsbl_%dl,%edx 0fbed2
+#DEFINE movswl_%cx,%ecx 0fbfc9
+#DEFINE movzbl_%cl,%ecx 0fb6c9
+#DEFINE movzbl_%dl,%edx 0fb6d2
+#DEFINE movzbl_(%eax),%edx 0fb610
+#DEFINE movzbl_(%ecx),%ecx 0fb609
+#DEFINE movzbl_(%edx),%edx 0fb612
+#DEFINE movzwl_(%ecx),%ecx 0fb709
+#DEFINE mul____%ecx f7e1
+#DEFINE mul____%edi f7e7
+#DEFINE mul____%edx f7e2
+#DEFINE mul____%esi f7e6
+#DEFINE or_____%ecx,%ebx 09cb
+#DEFINE or_____%edx,%eax 09d0
+#DEFINE or_____(%edx),%eax 0b02
+#DEFINE pop____%ecx 59
+#DEFINE pop____%edi 5f
+#DEFINE push___%ecx 51
+#DEFINE push___%edi 57
+#DEFINE push___%esi 56
+#DEFINE shl____$i8,%ecx c1e1
+#DEFINE shl____$i8,%edx c1e2
+#DEFINE shl____%cl,%ecx d3e1
+#DEFINE sub____%eax,%edx 29c2
+#DEFINE sub____%ecx,%ebx 29cb
+#DEFINE sub____%edx,%eax 29d0
+#DEFINE sub____%edx,%ecx 29d1
+#DEFINE xchg___%ebx,%ecx 87d9
+#DEFINE xchg___%ecx,%edx 87ca
+#DEFINE xor____%ecx,%ecx 31c9
+#DEFINE xor____%edx,%eax 31d0
+
+
+
+
 # deprecated, remove after 0.18
 DEFINE sub____%esp,$i32 81ec
 DEFINE sub____%esp,$i8 83ec
index ae372638082dc47da844dd8cc8a5d016ee9c6533..8967b0fd482f58b1f589ddae00455a1d68b822dc 100644 (file)
  */
 
 #include <setjmp.h>
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
-#include <signal.h>
-#include <sys/mman.h>
-#include <sys/time.h>
-#include <unistd.h>
-
-int errno;
 
 void
 longjmp (jmp_buf env, int val)
 {
   val = val == 0 ? 1 : val;
-  asm ("mov    %esi,%eax\n\t"           // val
-
+  asm (
        "mov    0x00(%rdi),%rbp\n\t"     // env->__bp
        "mov    0x08(%rdi),%rbx\n\t"     // env->__pc
-       "mov    0x16(%rdi),%rsp\n\t"     // env->__sp
+       "mov    0x10(%rdi),%rsp\n\t"     // env->__sp
        "jmp    *%rbx\n\t"               // jmp *PC
        );
   // not reached
   exit (42);
 }
 
-#if 0
-int
-setjmp_debug (jmp_buf env, int val)
-{
-  int i;
-#if 1
-  i = env->__bp;
-  i = env->__pc;
-  i = env->__sp;
-#else
-  i = env[0].__bp;
-  i = env[0].__pc;
-  i = env[0].__sp;
-#endif
-  return val == 0 ? 1 : val;
-}
-#endif
-
 int
 setjmp (jmp_buf env)
 {
-  int *p = (int*)&env;
-  env[0].__bp = p[-2];
-  env[0].__pc = p[-1];
-  env[0].__sp = (long)&env;
+  long *p;
+  asm ("mov    %%rbp,%0"
+       : "=r" (p)
+       : //no inputs ""
+       );
+  env[0].__bp = p;
+  env[0].__pc = p[1];
+  env[0].__sp = p[0];
   return 0;
 }
diff --git a/lib/x86_64-mes/setjmp.c b/lib/x86_64-mes/setjmp.c
new file mode 100644 (file)
index 0000000..85a9ef0
--- /dev/null
@@ -0,0 +1,71 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2017,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/>.
+ */
+
+#include <setjmp.h>
+
+void
+longjmp (jmp_buf env, int val)
+{
+#if 0 //MES_CCAMD64
+  asm ("push___%rdi");
+#endif
+  val = val == 0 ? 1 : val;
+#if 0 //MES_CCAMD64
+  asm ("pop____%rdi");
+  asm ("mov____0x8(%rdi),%rbp !0x00");  // env->__bp
+  asm ("mov____0x8(%rdi),%rbx !0x08");  // env->__pc
+  asm ("mov____0x8(%rdi),%rsp !0x10");  // env->__sp
+  asm ("jmp____*%rbx");                 // jmp *PC
+#else
+  asm ("mov____0x8(%rbp),%rbp !0x10"); // env*
+
+  asm ("mov____0x8(%rbp),%rbx !0x08");  // env.__pc
+  asm ("mov____0x8(%rbp),%rsp !0x10");  // env.__sp
+  asm ("mov____0x8(%rbp),%rbp !0x00");  // env.__bp
+  asm ("jmp____*%rbx");
+#endif
+  // not reached
+  exit (42);
+}
+
+int
+setjmp (__jmp_buf *env)
+{
+#if 0 //MES_CCAMD64
+  asm ("mov____%rbp,%rax");
+  asm ("add____$i32,%rax %0x80");
+
+  asm ("mov____0x8(%rax),%rsi !0x00");
+  asm ("mov____%rsi,0x8(%rdi) !0x00");
+
+  asm ("mov____0x8(%rax),%rsi !0x08");
+  asm ("mov____%rsi,0x8(%rdi) !0x08");
+
+  asm ("mov____%rax,%rsi");
+  asm ("add____$i32,%rsi %0x10");
+  asm ("mov____%rsi,0x8(%rdi) !0x10");
+#else
+  long *p = (long*)&env;
+  env[0].__bp = p[-2];
+  env[0].__pc = p[-1];
+  env[0].__sp = (long)&env;
+#endif
+  return 0;
+}
index 10e6b9131cb48af5b4a88c8611a1a40eb06a37a0..70785ef906b3058f9511738a2ef3e9101aec2bc4 100644 (file)
 ### You should have received a copy of the GNU General Public License
 ### along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+# reduced instruction set: rax, rdi (some rcx for shift, rdx for mul, div)
+# 184 instructions
+# TODO: $i64/$0x64 instructions are missing
+DEFINE add____$i32,%rax 4805
+DEFINE add____$i32,%rbp 4881c5
+DEFINE add____$i32,%rdi 4881c7
+DEFINE add____$i32,(%rax) 8100
+DEFINE add____$i32,0x32(%rbp) 8185
 DEFINE add____$i8,%rax 4883c0
+DEFINE add____$i8,%rdi 4883c7
+DEFINE add____$i8,%rsp 4883c4
+DEFINE add____$i8,(%rax) 8300
+DEFINE add____$i8,(%rdi) 8307
+DEFINE add____$i8,0x8(%rbp) 8345
+DEFINE add____%rax,%rax 4801c0
 DEFINE add____%rbp,%rax 4801e8
+DEFINE add____%rdi,%rax 4801f8
+DEFINE add____%rdi,%rdi 4801ff
+DEFINE addb___$i8,(%rax) 8000
+DEFINE addb___$i8,(%rdi) 8007
+DEFINE addl___$i32,(%rax) 8100
+DEFINE addl___$i32,(%rdi) 8107
+DEFINE addl___$i8,(%rax) 8300
+DEFINE addl___$i8,(%rdi) 8307
+DEFINE addw___$i8,(%rax) 668100
+DEFINE addw___$i8,(%rdi) 668107
+DEFINE and____$i32,%rdi 4881e7
+DEFINE and____%rdi,%rax 4821f8
 DEFINE call32 e8
+DEFINE call___*%rax ffd0
+DEFINE call___*%rdi ffd7
+DEFINE cmp____$i32,%rax 483d
+DEFINE cmp____$i8,%rax 4883f8
 DEFINE hlt f4
+DEFINE idiv___%rdi 48f7ff
+DEFINE ja32  0f87
+DEFINE jae32 0f83
+DEFINE jb32  0f82
+DEFINE jbe32 0f86
+DEFINE je32 0f84
+DEFINE je8 74
+DEFINE jg32 0f8f
+DEFINE jge32 0f8d
+DEFINE jl32 0f8c
+DEFINE jle32 0f8e
+DEFINE jmp32 e9
+DEFINE jmp____*%rbx ffe3
+DEFINE jne32 0f85
+DEFINE lahf 9f
 DEFINE mov____$i32,%rax 48c7c0
 DEFINE mov____$i32,%rdi 48c7c7
 DEFINE mov____$i32,0x8(%rbp) c745
 DEFINE mov____$i64,%rax 48a1
+DEFINE mov____$i64,%rax 48b8
+DEFINE mov____%al,(%rdi) 8807
+DEFINE mov____%al,0x32(%rbp) 8885
+DEFINE mov____%al,0x8(%rbp) 8845
+DEFINE mov____%ax,(%rdi) 668907
+DEFINE mov____%ax,0x8(%rbp) 668945
+DEFINE mov____%eax,(%rdi) 8907
+DEFINE mov____%eax,0x32(%rbp)  8985
+DEFINE mov____%eax,0x8(%rbp) 8945
+DEFINE mov____%eax,0x8(%rbp) 8945
+DEFINE mov____%edi,0x32(%rbp) 89bd
 DEFINE mov____%edi,0x8(%rbp) 897d
-DEFINE mov____%r8,0x8(%rbp) 4c8945
+DEFINE mov____%esi,%eax 89f0
+DEFINE mov____%r8,%rdi 4c89c7
 DEFINE mov____%rax,%rax 4889c0
-DEFINE mov____%rax,%rbx 4889c3
 DEFINE mov____%rax,%rdi 4889c7
-DEFINE mov____%rax,%rsi 4889c6
+DEFINE mov____%rax,(%rdi) 488907
+DEFINE mov____%rax,0x32 48890425
+DEFINE mov____%rax,0x32(%rbp) 488985
 DEFINE mov____%rax,0x8(%rbp) 488945
+DEFINE mov____%rax,0x8(%rdi) 488947
 DEFINE mov____%rbp,%rax 4889e8
+DEFINE mov____%rbp,%rdi 4889ef
 DEFINE mov____%rbp,%rsp 4889ec
-DEFINE mov____%rcx,0x8(%rbp) 48894d
+DEFINE mov____%rbp,0x8(%rbp) 48896d
+DEFINE mov____%rdi,%r8 4989f8
+DEFINE mov____%rdi,%rax 4889f8
+DEFINE mov____%rdi,%rcx 4889f9
+DEFINE mov____%rdi,%rdi 4889ff
+DEFINE mov____%rdi,0x32 48893c25
+DEFINE mov____%rdi,0x32(%rbp) 4889bd
 DEFINE mov____%rdi,0x8(%rbp) 48897d
-DEFINE mov____%rdx,0x8(%rbp) 488955
-DEFINE mov____%rsi,0x8(%rbp) 488975
+DEFINE mov____%rdx,%rax 4889d0
+DEFINE mov____%rdx,%rdi 4889d7
+DEFINE mov____%rsi,(%rdi) 488937
 DEFINE mov____%rsp,%rbp 4889e5
+DEFINE mov____(%rax),%eax 8b00
 DEFINE mov____(%rax),%rax 488b00
+DEFINE mov____(%rax),%rsi 488b30
+DEFINE mov____(%rdi),%edi 8b3f
+DEFINE mov____(%rdi),%rdi 488b3f
+DEFINE mov____0x32(%rbp),%rax 488b85
+DEFINE mov____0x32(%rbp),%rdi 488bbd
+DEFINE mov____0x32,%rax 488b0425
+DEFINE mov____0x32,%rdi 488b3c25
 DEFINE mov____0x8(%rbp),%eax 8b45
+DEFINE mov____0x8(%rbp),%r10 4c8b55
+DEFINE mov____0x8(%rbp),%r8 4c8b45
 DEFINE mov____0x8(%rbp),%rax 488b45
+DEFINE mov____0x8(%rbp),%rbp 488b6d
+DEFINE mov____0x8(%rbp),%rbx 488b5d
+DEFINE mov____0x8(%rbp),%rcx 488b4d
+DEFINE mov____0x8(%rbp),%rdi 488b7d
+DEFINE mov____0x8(%rbp),%rdx 488b55
+DEFINE mov____0x8(%rbp),%rsi 488b75
+DEFINE mov____0x8(%rbp),%rsp 488b65
+DEFINE mov____0x8(%rdi),%rax 488b47
+DEFINE mov____0x8(%rdi),%rbp 488b6f
+DEFINE mov____0x8(%rdi),%rsp 488b67
+DEFINE movsbq_%al,%rax 480fbec0
+DEFINE movsbq_%dil,%rdi 480fbeff
+DEFINE movsbq_(%rax),%rax 480fbe00
+DEFINE movsbq_(%rdi),%rdi 480fbe3f
+DEFINE movslq_%eax,%rax 4863c0
+DEFINE movslq_%edi,%rdi 4863ff
+DEFINE movslq_(%rax),%rax 486300
+DEFINE movslq_(%rdi),%rdi 48633f
+DEFINE movswq_%ax,%rax 480fbfc0
+DEFINE movswq_%di,%rdi 480fbfff
+DEFINE movswq_(%rax),%rax 480fbf00
+DEFINE movswq_(%rdi),%rdi 480fbf3f
+DEFINE movz___(%rax),%rax 480fb600
+DEFINE movzbq_%al,%rax 480fb6c0
+DEFINE movzbq_%dil,%rdi 480fb6ff
+DEFINE movzbq_(%rax),%rax 480fb600
+DEFINE movzbq_(%rdi),%rdi 480fb63f
+DEFINE movzlq_(%rax),%rax 8b00
+DEFINE movzlq_(%rdi),%rdi 8b3f
+DEFINE movzwq_(%rax),%rax 480fb700
+DEFINE movzwq_(%rdi),%rdi 480fb73f
+DEFINE mul____%rdi 48f7e7
 DEFINE nop 90
+DEFINE not____%rax 48f7d0
+DEFINE not____%rdi 48f7d7
+DEFINE or_____%rdi,%rax 4809f8
+DEFINE pop____%rax 58
 DEFINE pop____%rbp 5d
+DEFINE pop____%rdi 5f
+DEFINE pop____%rdx 5a
+DEFINE push___$i32 68
+DEFINE push___%rax 50
 DEFINE push___%rbp 55
+DEFINE push___%rdi 57
+DEFINE push___%rdx 52
 DEFINE ret c3
+DEFINE sahf 9e
+DEFINE seta___%al 0f97c0
+DEFINE seta___%dil 400f97c7
+DEFINE setae__%al 0f93c0
+DEFINE setae__%dil 400f93c7
+DEFINE setb___%al 0f92c0
+DEFINE setb___%dil 400f92c7
+DEFINE setbe__%al 0f96c0
+DEFINE setbe__%dil 400f96c7
+DEFINE sete___%al 0f94c0
+DEFINE sete___%dil 400f94c7
+DEFINE setg___%al 0f9fc0
+DEFINE setg___%dil 400f9fc7
+DEFINE setge__%al 0f9dc0
+DEFINE setge__%dil 400f9dc7
+DEFINE setl___%al 0f9cc0
+DEFINE setle__%al 0f9ec0
+DEFINE setle__%dil 400f9ec7
+DEFINE setne__%al 0f95c0
 DEFINE shl____$i8,%rax 48c1e0
+DEFINE shl____$i8,%rdi 48c1e7
+DEFINE shl____%cl,%rax 48d3e0
+DEFINE shl____%cl,%rdi 48d3e7
+DEFINE shr____%cl,%rax 48d3e8
+DEFINE sub____$i32,%rbp 4881ed
 DEFINE sub____$i32,%rsp 4881ec
+DEFINE sub____%rdi,%rax 4829f8
 DEFINE syscall 0f05
+DEFINE test___%al,%al 84c0
 DEFINE test___%rax,%rax 4885c0
+DEFINE test___%rdi,%rdi 4885ff
+DEFINE xchg___%rax,%rdi 4897
+DEFINE xchg___%rax,(%rsp) 48870424
+DEFINE xchg___%rdi,(%rsp) 48873c24
+DEFINE xor____$i8,%ah 80f4
+DEFINE xor____%rax,%rax 4831c0
+DEFINE xor____%rdi,%rax 4831f8
+DEFINE xor____%rdx,%rdx 4831d2
 
-DEFINE SYS_exit 3c000000
+
+# Enough for all of Mes + Mes C Libray when using all registers, i.e.,
+# non-reduced instruction set
+#DEFINE add____$i32,%rdx 4881c2
+#DEFINE add____$i32,%rsi 4881c6
+#DEFINE add____$i8,%rcx 4883c1
+#DEFINE add____$i8,%rdx 4883c2
+#DEFINE add____$i8,%rsi 4883c6
+#DEFINE add____$i8,(%rsi) 488306
+#DEFINE add____%rdx,%rdx 4801d2
+#DEFINE add____%rdx,%rsi 4801d6
+#DEFINE add____%rsi,%rdi 4801f7
+#DEFINE add____%rsi,%rsi 4801f6
+#DEFINE addl___$i32,(%rsi) 8106
+#DEFINE addl___$i8,(%rsi) 8306
+#DEFINE and____$i32,%rsi 4881e6
+#DEFINE idiv___%rcx 48f7f9
+#DEFINE idiv___%rsi 48f7fe
+#DEFINE mov____$i32,%r8 49c7c0
+#DEFINE mov____$i32,%r9 49c7c1
+#DEFINE mov____$i32,%rcx 48c7c1
+#DEFINE mov____$i32,%rdx 48c7c2
+#DEFINE mov____$i32,%rsi 48c7c6
+#DEFINE mov____%dil,(%rsi) 40883e
+#DEFINE mov____%edi,(%rsi) 893e
+#DEFINE mov____%r8,%r8 4d89c0
+#DEFINE mov____%r8,0x8(%rbp) 4c8945
+#DEFINE mov____%r9,%r9 4d89c9
+#DEFINE mov____%r9,%rdi 4c89cf
+#DEFINE mov____%r9,0x8(%rbp) 4c894d
+#DEFINE mov____%rax,%rbx 4889c3
+#DEFINE mov____%rax,%rcx 4889c1
+#DEFINE mov____%rax,%rdx 4889c2
+#DEFINE mov____%rax,%rsi 4889c6
+#DEFINE mov____%rbp,%rcx 4889e9
+#DEFINE mov____%rbp,%rdx 4889ea
+#DEFINE mov____%rbp,%rsi 4889ee
+#DEFINE mov____%rcx,%rcx 4889c9
+#DEFINE mov____%rcx,%rdi 4889cf
+#DEFINE mov____%rcx,%rdx 4889ca
+#DEFINE mov____%rcx,%rsi 4889ce
+#DEFINE mov____%rcx,0x8(%rbp) 48894d
+#DEFINE mov____%rdi,%rdx 4889fa
+#DEFINE mov____%rdi,%rsi 4889fe
+#DEFINE mov____%rdx,%rcx 4889d1
+#DEFINE mov____%rdx,%rdx 4889d2
+#DEFINE mov____%rdx,%rsi 4889d6
+#DEFINE mov____%rdx,0x8(%rbp) 488955
+#DEFINE mov____%rsi,%rax 4889f0
+#DEFINE mov____%rsi,%rcx 4889f1
+#DEFINE mov____%rsi,%rdi 4889f7
+#DEFINE mov____%rsi,%rdx 4889f2
+#DEFINE mov____%rsi,%rsi 4889f6
+#DEFINE mov____%rsi,0x32 48893425
+#DEFINE mov____%rsi,0x8(%rbp) 488975
+#DEFINE mov____%rsi,0x8(%rdi) 488977
+#DEFINE mov____(%rdx),%edx 8b12
+#DEFINE mov____(%rdx),%rdx 488b12
+#DEFINE mov____(%rsi),%rsi 488b36
+#DEFINE mov____0x32(%rbp),%rcx 488b8d
+#DEFINE mov____0x32(%rbp),%rdx 488b95
+#DEFINE mov____0x32(%rbp),%rsi 488bb5
+#DEFINE mov____0x32,%rcx 488b0c25
+#DEFINE mov____0x32,%rdx 488b1425
+#DEFINE mov____0x32,%rsi 488b3425
+#DEFINE mov____0x8(%rax),%rsi 488b70
+#DEFINE mov____0x8(%rdi),%rbx 488b5f
+#DEFINE movsbq_%cl,%rcx 480fbec9
+#DEFINE movsbq_%dl,%rdx 480fbed2
+#DEFINE movsbq_%sil,%rsi 480fbef6
+#DEFINE movslq_%ecx,%rcx 4863c9
+#DEFINE movslq_%edx,%rdx 4863d2
+#DEFINE movslq_%esi,%rsi 4863f6
+#DEFINE movswq_%si,%rsi 480fbff6
+#DEFINE movzbq_%dl,%rdx 480fb6d2
+#DEFINE movzbq_%sil,%rsi 480fb6f6
+#DEFINE movzbq_(%rsi),%rsi 480fb636
+#DEFINE movzlq_(%rdx),%rdx 8b12
+#DEFINE movzlq_(%rsi),%rsi 8b36
+#DEFINE movzwq_(%rsi),%rsi 480fb736
+#DEFINE mul____%rbx 48f7e3
+#DEFINE mul____%rcx 48f7e1
+#DEFINE mul____%rdx 48f7e2
+#DEFINE mul____%rsi 48f7e6
+#DEFINE or_____%rdx,%rsi 4809d6
+#DEFINE or_____%rsi,%rdi 4809f7
+#DEFINE pop____%rcx 59
+#DEFINE pop____%rsi 5e
+#DEFINE push___%rcx 51
+#DEFINE push___%rsi 56
+#DEFINE shl____$i8,%rsi 48c1e6
+#DEFINE shl____%cl,%rsi 48d3e6
+#DEFINE sub____$i32,%rsi 4881ee
+#DEFINE sub____%rcx,%rdx 4829ca
+#DEFINE sub____%rdx,%rsi 4829d6
+#DEFINE sub____%rsi,%rdi 4829f7
+#DEFINE test___%rdx,%rdx 4885d2
+#DEFINE xchg___%rdi,%rsi 4887fe
+#DEFINE xchg___%rdx,%rcx 4887d1
+#DEFINE xchg___%rsi,%rdx 4887f2
+
+DEFINE SYS_write 01000000
+DEFINE SYS_exit  3c000000
index e83f3f6227902550ffd4bf989215cd00818735b6..f18591a3c47e41016ecd0ae0d15e71ddd72c196f 100644 (file)
@@ -20,4 +20,5 @@
 
 (mes-use-module (mescc as))
 (mes-use-module (mescc info))
+(mes-use-module (mescc x86_64 info))
 (include-from-path "mescc/x86_64/as.scm")
index b9db628ef920ecf6bccad5b686b87cdbef52c512..386e9dcde0d6302bbcfcb704c631c22108d62ee2 100644 (file)
@@ -23,4 +23,3 @@
 ;;; Code:
 
 (include-from-path "nyacc/version.scm")
-(display "nyacc version\n")
index 7ee1de717a60b4bff455baff99086ef9b01e95b5..7ee083eb3460a4de20efc10bca14c90c39f8d37f 100644 (file)
   (if hex? (string-append "!0x" (dec->hex o))
       (string-append "!" (number->string o))))
 
+(define (hex2:immediate2 o)
+  (if hex? (string-append "@0x" (dec->hex o))
+      (string-append "@" (number->string o))))
+
+(define (hex2:immediate4 o)
+  (if hex? (string-append "%0x" (dec->hex o))
+      (string-append "%" (number->string o))))
+
 (define* (display-join o #:optional (sep ""))
   (let loop ((o o))
     (when (pair? o)
@@ -87,7 +95,8 @@
       (let ((index (list-index (lambda (s) (equal? s o)) strings)))
         (if index
             (string-append "_string_" file-name "_" (number->string index))
-            (error "no such string:" o))))
+            (if (equal? o "%0") o       ; FIXME: 64b
+                (error "no such string:" o)))))
     (define (text->M1 o)
       (cond
        ((char? o) (text->M1 (char->integer o)))
           ((#:offset1 ,offset1) (hex2:offset1 offset1))
           ((#:immediate ,immediate) (hex2:immediate immediate))
           ((#:immediate1 ,immediate1) (hex2:immediate1 immediate1))
+          ((#:immediate2 ,immediate2) (hex2:immediate2 immediate2))
+          ((#:immediate4 ,immediate4) (hex2:immediate4 immediate4))
           (_ (error "text->M1 no match o" o))))
        ((pair? o) (string-join (map text->M1 o)))))
     (define (write-function o)
                    (string? (not (equal? string-label "_string_#f"))))
               (cond ((and (pair? o) (global? (cdr o))) (string-append "&" (global->string o)))
                     ((and (not string?) (not function?)) (stderr "warning: unresolved label: ~s\n" label))
+                    ((equal? string-label "%0") o) ;; FIXME: 64b
                     (else (string-append "&" label))))))
       (define (display-align size)
         (let ((alignment (- 4 (modulo size 4))))
index b2e650d0c236128d17e229d78f234ee59d57a458..a91e18d89707eb1b950c4cb03caa46748703ce20 100644 (file)
             dec->hex
             int->bv8
             int->bv16
-            int->bv32))
+            int->bv32
+            int->bv64
+            get-r
+            get-r0
+            get-r1
+            get-r-1))
+
+(define (int->bv64 value)
+  (let ((bv (make-bytevector 8)))
+    (bytevector-u64-native-set! bv 0 value)
+    bv))
 
 (define (int->bv32 value)
   (let ((bv (make-bytevector 4)))
         (else (format #f "~s" o))))
 
 (define (as info instruction . rest)
-  (let ((proc (assoc-ref (.instructions info) instruction)))
-    (apply proc info rest)))
+  (if (pair? instruction)
+      (append-map (lambda (o) (apply as (cons* info o rest))) instruction)
+      (let ((proc (assoc-ref (.instructions info) instruction)))
+        (if (not proc) (error "no such instruction" instruction)
+            (apply proc info rest)))))
+
+(define (get-r info)
+  (car (if (pair? (.allocated info)) (.allocated info) (.registers info))))
+
+(define (get-r0 info)
+  (cadr (.allocated info)))
+
+(define (get-r1 info)
+  (car (.allocated info)))
+
+(define (get-r-1 info)
+  (caddr (.allocated info)))
index 1bb01981a8149341e6dd0801c7118df9e16719c6..fe2e4311b85f3fcba1c1d58fd5d45f37121a7cc7 100644 (file)
 
 (define-module (mescc bytevectors)
   #:use-module (mes guile)
-  #:export (bytevector-u32-native-set!
+  #:export (bytevector-u64-native-set!
+            bytevector-u32-native-set!
             bytevector-u16-native-set!
             bytevector-u8-set!
             make-bytevector))
 
 ;; rnrs compatibility
+(define (bytevector-u64-native-set! bv index value)
+  (when (not (= 0 index)) (error "bytevector-u64-native-set! index not zero: " index " value: " value))
+  (let ((x (list
+            (modulo value #x100)
+            (modulo (ash value -8) #x100)
+            (modulo (ash value -16) #x100)
+            (modulo (ash value -24) #x100)
+            (modulo (ash value -32) #x100)
+            (modulo (ash value -40) #x100)
+            (modulo (ash value -48) #x100)
+            (modulo (ash value -56) #x100))))
+    (set-car! bv (car x))
+    (set-cdr! bv (cdr x))
+    x))
+
 (define (bytevector-u32-native-set! bv index value)
   (when (not (= 0 index)) (error "bytevector-u32-native-set! index not zero: " index " value: " value))
   (let ((x (list
index e57541d6c38601ef631d73ff899befd0420abd84..a9504f642542519ef4e0a7f0f14b91254c1de567 100644 (file)
             c99-input->object))
 
 (define mes? (pair? (current-module)))
+(define (cc-amd? info) #f)              ; use AMD calling convention?
+;; (define %reduced-register-count #f)     ; use all registers?
+(define %reduced-register-count 2)      ; use reduced instruction set
+(define (max-registers info)
+  (if %reduced-register-count %reduced-register-count
+   (length (append (.registers info) (.allocated info)))))
 
 (define* (c99-input->info info #:key (prefix "") (defines '()) (includes '()))
   (let ((ast (c99-input->ast #:prefix prefix #:defines defines #:includes includes)))
     #:functions (filter (compose pair? function:text cdr) (.functions o))
     #:globals (.globals o)))
 
-(define %int-size 4)
-(define %pointer-size %int-size)
-
 (define (ident->constant name value)
   (cons name value))
 
 (define (enum->type-entry name fields)
   (cons `(tag ,name) (make-type 'enum 4 fields)))
 
-(define (struct->type-entry name fields)
-  (let ((size (apply + (map (compose ->size cdr) fields))))
+(define (struct->type-entry info name fields)
+  (let ((size (apply + (map (compose (cut ->size <> info) cdr) fields))))
     (cons `(tag ,name) (make-type 'struct size fields))))
 
-(define (union->type-entry name fields)
-  (let ((size (apply max (map (compose ->size cdr) fields))))
+(define (union->type-entry info name fields)
+  (let ((size (apply max (map (compose (cut ->size <> info) cdr) fields))))
     (cons `(tag ,name) (make-type 'union size fields))))
 
 (define (signed? o)
 (define (unsigned? o)
   (eq? ((compose type:type ->type) o) 'unsigned))
 
-(define (->size o)
+(define (->size o info)
   (cond ((and (type? o) (eq? (type:type o) 'union))
-         (apply max (map (compose ->size cdr) (struct->fields o))))
+         (apply max (map (compose (cut ->size <> info) cdr) (struct->fields o))))
         ((type? o) (type:size o))
-        ((pointer? o) %pointer-size)
-        ((c-array? o) (* (c-array:count o) ((compose ->size c-array:type) o)))
-        ((local? o) ((compose ->size local:type) o))
-        ((global? o) ((compose ->size global:type) o))
-        ((bit-field? o) ((compose ->size bit-field:type) o))
-        ((and (pair? o) (pair? (car o)) (bit-field? (cdar o))) ((compose ->size cdar) o))
-        ;; FIXME
-        ;; (#t
-        ;;  (stderr "o=~s\n" o)
-        ;;  (format (current-error-port) "->size: not a <type>: ~s\n" o)
-        ;;  4)
+        ((pointer? o) (->size (get-type "*" info) info))
+        ((c-array? o) (* (c-array:count o) ((compose (cut ->size <> info) c-array:type) o)))
+        ((local? o) ((compose (cut ->size <> info) local:type) o))
+        ((global? o) ((compose (cut ->size <> info) global:type) o))
+        ((bit-field? o) ((compose (cut ->size <> info) bit-field:type) o))
+        ((and (pair? o) (pair? (car o)) (bit-field? (cdar o))) ((compose (cut ->size <> info) cdar) o))
+        ((string? o) (->size (get-type o info) info))
         (else (error "->size>: not a <type>:" o))))
 
 (define (ast->type o info)
       ((type-name ,type) (ast->type type info))
       ((type-spec ,type) (ast->type type info))
 
-      ((sizeof-expr ,expr) (ast->type expr info))
-      ((sizeof-type ,type) (ast->type type info))
+      ((sizeof-expr ,expr) (get-type "default" info))
+      ((sizeof-type ,type) (get-type "default" info))
 
       ((string ,string) (make-c-array (get-type "char" info) (1+ (string-length string))))
 
        (ast->type `(tag ,name) info))
       ((struct-def (field-list . ,fields))
        (let ((fields (append-map (struct-field info) fields)))
-         (make-type 'struct (apply + (map field:size fields)) fields)))
+         (make-type 'struct (apply + (map (cut field:size <> info) fields)) fields)))
       ((union-def (field-list . ,fields))
        (let ((fields (append-map (struct-field info) fields)))
-         (make-type 'union (apply + (map field:size fields)) fields)))
+         (make-type 'union (apply + (map (cut field:size <> info) fields)) fields)))
       ((enum-def (enum-def-list . ,fields))
        (get-type "default" info))
 
       ((typedef ,next) (or (get-type next info) o))
       (_ t))))
 
-
 (define (ast-type->size info o)
   (let ((type (->type (ast->type o info))))
     (cond ((type? type) (type:size type))
-          (else (stderr "ast-type->size barf: ~s => ~s\n" o type)
+          (else (stderr "error: ast-type->size: ~s => ~s\n" o type)
                 4))))
 
 (define (field:name o)
     ((,name . ,type) (->rank type))
     (_ (error "field:pointer not supported:" o))))
 
-(define (field:size o)
+(define (field:size o info)
   (pmatch o
-    ((struct . ,type) (apply + (map field:size (struct->fields type))))
-    ((union . ,type) (apply max (map field:size (struct->fields type))))
-    ((,name . ,type) (->size type))
+    ((struct . ,type) (apply + (map (cut field:size <> info) (struct->fields type))))
+    ((union . ,type) (apply max (map (cut field:size <> info) (struct->fields type))))
+    ((,name . ,type) (->size type info))
     (_ (error (format #f "field:size: ~s\n" o)))))
 
 (define (field-field info struct field)
                        (let ((fields (type:description (cdr f))))
                          (find (lambda (x) (equal? (car x) field)) fields)
                          (apply + (cons offset
-                                        (map field:size
+                                        (map (cut field:size <> info)
                                              (member field (reverse fields)
                                                      (lambda (a b)
                                                        (equal? a (car b) field))))))))
                               (and (find (lambda (x) (equal? (car x) field)) fields)
                                    offset))))
                       ((and (eq? (car f) 'bits) (assoc-ref (cdr f) field)) offset)
-                      (else (loop (cdr fields) (+ offset (field:size f)))))))))))
+                      (else (loop (cdr fields) (+ offset (field:size f info)))))))))))
 
 (define (field-pointer info struct field)
   (let ((field (field-field info struct field)))
 (define (field-size info struct field)
   (if (eq? (type:type struct) 'union) 0
       (let ((field (field-field info struct field)))
-        (field:size field))))
+        (field:size field info))))
 
 (define (field-size info struct field)
   (let ((field (field-field info struct field)))
-    (field:size field)))
+    (field:size field info)))
 
 (define (field-type info struct field)
   (let ((field (field-field info struct field)))
     (_ (guard (and (type? o) (eq? (type:type o) 'struct)))
        (append-map struct->init-fields (type:description o)))
     (_ (guard (and (type? o) (eq? (type:type o) 'union)))
-       (append-map struct->init-fields (type:description o)))
+       (list (car (type:description o))))
     ((struct . ,type) (struct->init-fields type))
     ((union . ,type) (list (car (type:description type))))
     (_ (list o))))
           ((function? var) (function:type var))
           ((assoc-ref (.constants info) o) (assoc-ref (.types info) "default"))
           ((pair? var) (car var))
-          (else (stderr "ident->type ~s => ~s\n" o var)
+          (else (stderr "error: ident->type ~s => ~s\n" o var)
                 #f))))
 
 (define (local:pointer o)
   (->rank (ast->type o info)))
 
 (define (ast->size o info)
-  (->size (ast->type o info)))
+  (->size (ast->type o info) info))
 
 (define (append-text info text)
   (clone info #:text (append (.text info) text)))
 
-(define (push-global info)
-  (lambda (o)
-    (let ((rank (ident->rank info o)))
-      (cond ((< rank 0) (list (i386:push-label `(#:address ,o)))) ;; FIXME
-            (else (list (i386:push-label-mem `(#:address ,o))))))))
-
-(define (push-local locals)
-  (lambda (o)
-    (wrap-as (i386:push-local (local:id o)))))
-
-(define (push-global-address info)
-  (lambda (o)
-    (list (i386:push-label o))))
-
-(define (push-local-address locals)
-  (lambda (o)
-    (wrap-as (i386:push-local-address (local:id o)))))
-
-(define (push-local-de-ref info)
-  (lambda (o)
-    (let ((size (->size o)))
-      (case size
-        ((1) (wrap-as (i386:push-byte-local-de-ref (local:id o))))
-        ((2) (wrap-as (i386:push-word-local-de-ref (local:id o))))
-        ((4) (wrap-as (i386:push-local-de-ref (local:id o))))
-        (else (error (format #f "TODO: push size >4: ~a\n" size)))))))
-
- ;; (if (= ptr 2) (ast-type->size info (local:type o)) ;; URG
- ;;                       4)
-(define (push-local-de-de-ref info)
-  (lambda (o)
-    (let ((size (->size (rank-- (rank-- o)))))
-      (if (= size 1)
-          (wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
-          (error "TODO int-de-de-ref")))))
-
 (define (make-global-entry name type value)
   (cons name (make-global name type value #f)))
 
 (define (string->global-entry string)
   (let ((value (append (string->list string) (list #\nul))))
-   (make-global-entry `(#:string ,string) "char" value))) ;; FIXME char-array
+   (make-global-entry `(#:string ,string) "char" value)))
 
 (define (make-local-entry name type id)
   (cons name (make-local name type id)))
 (define* (mescc:trace name #:optional (type ""))
   (format (current-error-port) "    :~a~a\n" name type))
 
-(define (push-ident info)
-  (lambda (o)
-    (cond ((assoc-ref (.locals info) o)
-           =>
-           (push-local (.locals info)))
-          ((assoc-ref (.statics info) o)
-           =>
-           (push-global info))
-          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
-           =>
-           (push-global info))
-          ((assoc-ref (.constants info) o)
-           =>
-           (lambda (constant)
-             (wrap-as (append (i386:value->accu constant)
-                              (i386:push-accu)))))
-          (else
-           ((push-global-address #f) `(#:address ,o))))))
-
-(define (push-ident-address info)
-  (lambda (o)
-    (cond ((assoc-ref (.locals info) o)
-           =>
-           (push-local-address (.locals info)))
-          ((assoc-ref (.statics info) o)
-           =>
-           (push-global-address info))
-          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
-           =>
-           (push-global-address info))
-          (else
-           ((push-global-address #f) `(#:address ,o))))))
-
-(define (push-ident-de-ref info)
-  (lambda (o)
-    (cond ((assoc-ref (.locals info) o)
-           =>
-           (push-local-de-ref info))
-          (else ((push-global info) o)))))
-
-(define (push-ident-de-de-ref info)
-  (lambda (o)
-    (cond ((assoc-ref (.locals info) o)
-           =>
-           (push-local-de-de-ref info))
-          (else
-           (error "not supported: global push-ident-de-de-ref:" o)))))
-
-(define (expr->arg info)
-  (lambda (o)
-    (pmatch o
-      ((p-expr (string ,string))
-       (let* ((globals ((globals:add-string (.globals info)) string))
-              (info (clone info #:globals globals)))
-         (append-text info ((push-global-address info) `(#:string ,string)))))
-      (_ (let ((info (expr->register o info)))
-           (append-text info (wrap-as (i386:push-accu))))))))
+(define (expr->arg o i info)
+  (pmatch o
+    ((p-expr (string ,string))
+     (let* ((globals ((globals:add-string (.globals info)) string))
+            (info (clone info #:globals globals))
+            (info (allocate-register info))
+            (info (append-text info (wrap-as (as info 'label->arg `(#:string ,string) i))))
+            (no-swap? (zero? (.pushed info)))
+            (info (if (cc-amd? info) info (free-register info)))
+            (info (if no-swap? info
+                      (append-text info (wrap-as (as info 'swap-r1-stack))))))
+       info))
+    (_ (let* ((info (expr->register o info))
+              (info (append-text info (wrap-as (as info 'r->arg i))))
+              (no-swap? (zero? (.pushed info)))
+              (info (if (cc-amd? info) info (free-register info)))
+              (info (if no-swap? info
+                        (append-text info (wrap-as (as info 'swap-r1-stack))))))
+         info))))
 
 (define (globals:add-string globals)
   (lambda (o)
       (if (assoc-ref globals string) globals
           (append globals (list (string->global-entry o)))))))
 
-(define (ident->accu info)
-  (lambda (o)
-    (cond ((assoc-ref (.locals info) o) => local->accu)
-          ((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)))))))
-
-(define (local->accu o)
-  (let* ((type (local:type o)))
-    (cond ((or (c-array? type)
-               (structured-type? type)) (wrap-as (i386:local-ptr->accu (local:id o))))
-          (else (append (wrap-as (i386:local->accu (local:id o)))
-                        (convert-accu type))))))
-
-(define (global->accu o)
-  (let ((type (global:type o)))
-    (cond ((or (c-array? type)
-               (structured-type? type)) (wrap-as (i386:label->accu `(#:address ,o))))
-          (else (append (wrap-as (i386:label-mem->accu `(#:address ,o)))
-                        (convert-accu type))))))
-
-(define (number->accu o)
-  (wrap-as (i386:value->accu o)))
-
-(define (ident->r0 info)
+(define (ident->r info)
   (lambda (o)
-    (cond ((assoc-ref (.locals info) o) => (cut local->r0 info <>))
+    (cond ((assoc-ref (.locals info) o) => (cut local->r <> info))
+          ((assoc-ref (.statics info) o) => (cut global->r <> info))
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o) => (cut global->r <> info))
+          ((assoc-ref (.constants info) o) => (cut value->r <> info))
+          (else (wrap-as (as info 'label->r `(#:address ,o)))))))
 
-          ((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))))
+(define (value->r o info)
+  (wrap-as (as info 'value->r 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)
+(define (local->r o info)
   (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)))
+           (wrap-as (as info 'local-ptr->r (local:id o))))
+          (else (append (wrap-as (as info 'local->r (local:id o)))
                         (convert-r0 info type))))))
 
-(define (ident-address->accu info)
-  (lambda (o)
-    (cond ((assoc-ref (.locals info) o)
-           =>
-           (lambda (local) (wrap-as (i386:local-ptr->accu (local:id local)))))
-          ((assoc-ref (.statics info) o)
-           =>
-           (lambda (global) (list (i386:label->accu `(#:address ,global)))))
-          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
-           =>
-           (lambda (global) (list (i386:label->accu `(#:address ,global)))))
-          (else (list (i386:label->accu `(#:address ,o)))))))
+(define (global->r o info)
+  (let ((type (global:type o)))
+    (cond ((or (c-array? type)
+               (structured-type? type)) (wrap-as (as info 'label->r `(#:address ,o))))
+          (else (append (wrap-as (as info 'label-mem->r `(#:address ,o)))
+                        (convert-r0 info type))))))
 
-(define (ident-address->base info)
-  (lambda (o)
-    (cond
-     ((assoc-ref (.locals info) o)
-      =>
-      (lambda (local) (wrap-as (i386:local-ptr->base (local:id local)))))
-     ((assoc-ref (.statics info) o)
-      =>
-      (lambda (global) (list (i386:label->base `(#:address ,global)))))
-     ((assoc-ref (filter (negate static-global?) (.globals info)) o)
-      =>
-      (lambda (global) (list (i386:label->base `(#:address ,global)))))
-     (else (list (i386:label->base `(#:address ,o)))))))
-
-(define (value->accu v)
-  (wrap-as (i386:value->accu v)))
-
-(define (accu->local+n-text local n)
-  (let ((id (local:id local))) (wrap-as (i386:accu->local+n id n))))
-
-(define (accu->ident info)
+(define (ident-address->r info)
   (lambda (o)
     (cond ((assoc-ref (.locals info) o)
            =>
-           (lambda (local) (let ((size (->size local)))
-                             (if (<= size 4) (wrap-as (i386:accu->local (local:id local)))
-                                 (wrap-as (i386:accu*n->local (local:id local) size))))))
+           (lambda (local) (wrap-as (as info 'local-ptr->r (local:id local)))))
           ((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))))))
+           (lambda (global) (wrap-as (as info 'label->r `(#:address ,global)))))
           ((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 (r0->ident info)
+           (lambda (global) (wrap-as (as info 'label->r `(#:address ,global)))))
+          (else (wrap-as (as info 'label->r `(#:address ,o)))))))
+
+(define (r->local+n-text info local n)
+  (let* ((id (local:id local))
+         (type (local:type local))
+         (type* (cond
+                 ((pointer? type) type)
+                 ((c-array? type) (c-array:type type))
+                 ((type? type) type)
+                 (else
+                  (stderr "unexpected type: ~s\n" type)
+                  type)))
+         (size (->size type* info))
+         (reg-size (->size "*" info))
+         (size (if (= size reg-size) 0 size)))
+    (case size
+      ((0) (wrap-as (as info 'r->local+n id n)))
+      ((1) (wrap-as (as info 'byte-r->local+n id n)))
+      ((2) (wrap-as (as info 'word-r->local+n id n)))
+      ((4) (wrap-as (as info 'long-r->local+n id n)))
+      (else
+       (stderr "unexpected size:~s\n" size)
+       (wrap-as (as info 'r->local+n id n))))))
+
+(define (r->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))
-                                 ))))
+           (lambda (local) (let ((size (->size local info))
+                                 (r-size (->size "*" info)))
+                             (wrap-as (as info 'r->local (local:id local))))))
           ((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))))))
+           (lambda (global) (let ((size (->size global info))
+                                  (r-size (->size "*" info)))
+                              (wrap-as (as info 'r->label global)) )))
           ((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)
-           =>
-           (lambda (local) (wrap-as (i386:value->local (local:id local) value))))
-          ((assoc-ref (.statics info) o)
-           =>
-           (lambda (global) (list (i386:value->label `(#:address ,global) value))))
-          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
-           =>
-           (lambda (global) (list (i386:value->label `(#:address ,global) value)))))))
+           (lambda (global) (let ((size (->size global info))
+                                  (r-size (->size "*" info)))
+                              (wrap-as (as info 'r->label global))))))))
 
 (define (ident-add info)
   (lambda (o n)
     (cond ((assoc-ref (.locals info) o)
            =>
-           (lambda (local) (wrap-as (i386:local-add (local:id local) n))))
-          ((assoc-ref (.statics info) o)
-           =>
-           (lambda (global) (list (i386:label-mem-add `(#:address ,o) n))))
-          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
-           =>
-           (lambda (global) (list (i386:label-mem-add `(#:address ,global) n)))))))
-
-(define (ident-address-add info)
-  (lambda (o n)
-    (cond ((assoc-ref (.locals info) o)
-           =>
-           (lambda (local) (wrap-as (append (i386:push-accu)
-                                            (i386:local->accu (local:id local))
-                                            (i386:accu-mem-add n)
-                                            (i386:pop-accu)))))
+           (lambda (local) (wrap-as (as info 'local-add (local:id local) n))))
           ((assoc-ref (.statics info) o)
            =>
-           (lambda (global) (list (wrap-as (append (i386:push-accu)
-                                                   (i386:label->accu `(#:address ,global))
-                                                   (i386:accu-mem-add n)
-                                                   (i386:pop-accu))))))
+           (lambda (global) (wrap-as (append
+                                      (as info 'label-mem-add `(#:address ,o) n)))))
           ((assoc-ref (filter (negate static-global?) (.globals info)) o)
            =>
-           (lambda (global) (list (wrap-as (append (i386:push-accu)
-                                                   (i386:label->accu `(#:address ,global))
-                                                   (i386:accu-mem-add n)
-                                                   (i386:pop-accu)))))))))
+           (lambda (global) (wrap-as (append
+                                      (as info 'label-mem-add `(#:address ,global) n))))))))
 
 (define (make-comment o)
   (wrap-as `((#:comment ,o))))
 
 (define (ast->comment o)
   (if mes? '()
-      (let* ((source (with-output-to-string (lambda () (pretty-print-c99 o))))
-             ;; Nyacc 0.80.42 fixups
-             (source (string-substitute source "'\\'" "'\\\\'"))
-             (source (string-substitute source "'\"'" "'\\\"'"))
-             (source (string-substitute source "'''" "'\\''")))
+      (let ((source (with-output-to-string (lambda () (pretty-print-c99 o)))))
         (make-comment (string-join (string-split source #\newline) " ")))))
 
-(define (accu*n info n)
-  (append-text info (wrap-as (case n
-                               ((1) (i386:accu->base))
-                               ((2) (i386:accu+accu))
-                               ((3) (append (i386:accu->base)
-                                            (i386:accu+accu)
-                                            (i386:accu+base)))
-                               ((4) (i386:accu-shl 2))
-                               ((8) (append (i386:accu+accu)
-                                            (i386:accu-shl 2)))
-                               ((12) (append (i386:accu->base)
-                                             (i386:accu+accu)
-                                             (i386:accu+base)
-                                             (i386:accu-shl 2)))
-                               ((16) (i386:accu-shl 4))
-                               (else (append (i386:value->base n)
-                                             (i386:accu*base)))))))
-
-(define (accu->base-mem*n- info n)
-  (wrap-as
-   (case n
-     ((1) (i386:byte-accu->base-mem))
-     ((2) (i386:word-accu->base-mem))
-     ((4) (i386:accu->base-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 (accu->base-mem*n info n)
-  (append-text info (accu->base-mem*n- info n)))
-
-(define (alloc-register info)
-  (let ((registers (.registers info)))
-    ;; (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 (r*n info n)
+  (case n
+    ((1) info)
+    ((2) (append-text info (wrap-as (as info 'r+r))))
+    ((3) (let* ((info (allocate-register info))
+                (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                         (as info 'r+r)
+                                                         (as info 'r0+r1)))))
+                (info (free-register info)))
+           info))
+    ((4) (append-text info (wrap-as (as info 'shl-r 2))))
+    ((5) (let* ((info (allocate-register info))
+                (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                         (as info 'r+r)
+                                                         (as info 'r+r)
+                                                         (as info 'r0+r1)))))
+                (info (free-register info)))
+           info))
+    ((6) (let* ((info (allocate-register info))
+                (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                         (as info 'r+r)
+                                                         (as info 'r0+r1)))))
+                (info (free-register info))
+                (info (append-text info (wrap-as (append (as info 'shl-r 1))))))
+           info))
+    ((8) (append-text info (wrap-as (append (as info 'shl-r 3)))))
+    ((10) (let* ((info (allocate-register info))
+                 (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                          (as info 'r+r)
+                                                          (as info 'r+r)
+                                                          (as info 'r0+r1)))))
+                 (info (free-register info))
+                 (info (append-text info (wrap-as (append (as info 'shl-r 1))))))
+            info))
+    ((12) (let* ((info (allocate-register info))
+                 (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                          (as info 'r+r)
+                                                          (as info 'r0+r1)))))
+                 (info (free-register info))
+                 (info (append-text info (wrap-as (append (as info 'shl-r 2))))))
+            info))
+    ((16) (append-text info (wrap-as (as info 'shl-r 4))))
+    ((20) (let* ((info (allocate-register info))
+                 (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                          (as info 'r+r)
+                                                          (as info 'r+r)
+                                                          (as info 'r0+r1)))))
+                 (info (free-register info))
+                 (info (append-text info (wrap-as (append (as info 'shl-r 2))))))
+            info))
+    ((24) (let* ((info (allocate-register info))
+                 (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                          (as info 'r+r)
+                                                          (as info 'r0+r1)))))
+                 (info (free-register info))
+                 (info (append-text info (wrap-as (append (as info 'shl-r 3))))))
+            info))
+
+    (else (let* ((info (allocate-register info))
+                 (info (append-text info (wrap-as (as info 'value->r n))))
+                 (info (append-text info (wrap-as (as info 'r0*r1))))
+                 (info (free-register info)))
+            info))))
+
+(define (allocate-register info)
+  (let ((registers (.registers info))
+        (allocated (.allocated info)))
+    (if (< (length allocated) (max-registers info))
+        (clone info #:allocated (cons (car registers) (.allocated info)) #:registers (cdr registers))
+        (let* ((info (clone info #:pushed (1+ (.pushed info))))
+               (info (append-text info (wrap-as (append (as info 'push-r0)
+                                                        (as info 'r1->r0))))))
+          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)))
-    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))
-  )
+  (let ((allocated (.allocated info))
+        (pushed (.pushed info)))
+    (if (zero? pushed)
+        (clone info #:allocated (cdr allocated) #:registers (cons (car allocated) (.registers info)))
+        (let* ((info (clone info #:pushed (1- pushed)))
+               (info (append-text info (wrap-as (append (as info 'r0->r1)
+                                                        (as info 'pop-r0))))))
+          info))))
+
+(define (push-register r info)
+  (append-text info (wrap-as (as info 'push-register r))))
+
+(define (pop-register r info)
+  (append-text info (wrap-as (as info 'pop-register r))))
+
+(define (r0->r1-mem*n- info n size)
+  (let ((reg-size (->size "*" info)))
+    (wrap-as
+     (cond
+       ((= n 1) (as info 'byte-r0->r1-mem))
+       ((= n 2) (cond ((= size 1) (append (as info 'byte-r0->r1-mem)
+                                          (as info 'r+value 1)
+                                          (as info 'value->r0 0)
+                                          (as info 'byte-r0->r1-mem)))
+                      (else (as info 'word-r0->r1-mem))))
+       ((= n 4) (as info 'long-r0->r1-mem))
+       ((and (= n 8) (or (= reg-size 8)
+                         (= size 4)))
+        (cond ((= size 4) (append (as info 'long-r0->r1-mem)
+                                  (as info 'r+value 4)
+                                  (as info 'value->r0 0)
+                                  (as info 'long-r0->r1-mem)))
+              ((and (= size 8) (= reg-size 8)) (as info 'quad-r0->r1-mem))
+              (else (error "r0->r1-mem*n-: not supported"))))
+       (else (append (let loop ((i 0))
+                       (if (>= i n) '()
+                           (append (if (= i 0) '()
+                                       (append (as info 'r+value reg-size)
+                                               (as info 'r0+value reg-size)))
+                                   (case (- n i)
+                                     ((1) (append (as info 'r+value -3)
+                                                  (as info 'r0+value -3)
+                                                  (as info 'r0-mem->r1-mem)))
+                                     ((2) (append (as info 'r+value -2)
+                                                  (as info 'r0+value -2)
+                                                  (as info 'r0-mem->r1-mem)))
+                                     ((3) (append (as info 'r+value -1)
+                                                  (as info 'r0+value -1)
+                                                  (as info 'r0-mem->r1-mem)))
+                                     (else (as info 'r0-mem->r1-mem)))
+                                   (loop (+ i reg-size)))))))))))
+
+(define (r0->r1-mem*n info n size)
+  (append-text info (r0->r1-mem*n- info n size)))
 
 (define (expr->register* o info)
-
   (pmatch o
-
     ((p-expr (ident ,name))
-     (let ((info (alloc-register info)))
-       (append-text info ((ident-address->accu info) name))))
+     (let ((info (allocate-register info)))
+       (append-text info ((ident-address->r info) name))))
 
     ((de-ref ,expr)
      (expr->register expr info))
      (let* ((type (ast->basic-type struct info))
             (offset (field-offset info type field))
             (info (expr->register* struct info)))
-       (append-text info (wrap-as (i386:accu+value offset)))))
+       (append-text info (wrap-as (as info 'r+value offset)))))
 
     ((i-sel (ident ,field) (fctn-call (p-expr (ident ,function)) . ,rest))
      (let* ((type (ast->basic-type `(fctn-call (p-expr (ident ,function)) ,@rest) info))
             (offset (field-offset info type field))
             (info (expr->register `(fctn-call (p-expr (ident ,function)) ,@rest) info)))
-       (append-text info (wrap-as (i386:accu+value offset)))))
+       (append-text info (wrap-as (as info 'r+value offset)))))
 
     ((i-sel (ident ,field) ,struct)
      (let* ((type (ast->basic-type struct info))
             (offset (field-offset info type field))
-            (info (expr->register* struct info)))
-       (append-text info (append (wrap-as (i386:mem->accu))
-                                 (wrap-as (i386:accu+value offset))))))
+            (info (expr->register* struct info))
+            (type (ast->type struct info)))
+       (append-text info (append (if (c-array? type) '()
+                                     (wrap-as (as info 'mem->r)))
+                                 (wrap-as (as info 'r+value offset))))))
 
     ((array-ref ,index ,array)
      (let* ((info (expr->register index info))
             (size (ast->size o info))
-            (info (accu*n info size))
-            (info (expr->base array info)))
-       (append-text info (wrap-as (i386:accu+base)))))
+            (info (r*n info size))
+            (info (expr->register array info))
+            (info (append-text info (wrap-as (as info 'r0+r1))))
+            (info (free-register info)))
+       info))
 
     ((cast ,type ,expr)
      (expr->register `(ref-to ,expr) info))
             (rank-b (expr->rank info b))
             (type (ast->basic-type a info))
             (struct? (structured-type? type))
+            (reg-size (->size "*" info))
             (size (cond ((= rank 1) (ast-type->size info a))
-                        ((> rank 1) 4)
-                        ((and struct? (= rank 2)) 4)
+                        ((> rank 1) reg-size)
+                        ((and struct? (= rank 2)) reg-size)
                         (else 1))))
-       (if (or (= size 1)) ((binop->accu* info) a b (i386:accu+base))
+       (if (or (= size 1)) ((binop->r* info) a b 'r0+r1)
            (let* ((info (expr->register b info))
-                  (info (append-text info (wrap-as (append (i386:value->base size)
-                                                           (i386:accu*base)
-                                                           (i386:accu->base)))))
-                  (info (expr->register* a info)))
-             (append-text info (wrap-as (i386:accu+base)))))))
+                  (info (allocate-register info))
+                  (info (append-text info (wrap-as (append (as info 'value->r size)
+                                                           (as info 'r0*r1)))))
+                  (info (free-register info))
+                  (info (expr->register* a info))
+                  (info (append-text info (wrap-as (as info 'r0+r1))))
+                  (info (free-register info)))
+             info))))
 
     ((sub ,a ,b)
      (let* ((rank (expr->rank info a))
             (rank-b (expr->rank info b))
             (type (ast->basic-type a info))
             (struct? (structured-type? type))
-            (size (->size type))
+            (size (->size type info))
+            (reg-size (->size "*" info))
             (size  (cond ((= rank 1) size)
-                         ((> rank 1) 4)
-                         ((and struct? (= rank 2)) 4)
+                         ((> rank 1) reg-size)
+                         ((and struct? (= rank 2)) reg-size)
                          (else 1))))
        (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
-           (let ((info ((binop->accu* info) a b (i386:accu-base))))
+           (let ((info ((binop->r* info) a b 'r0-r1)))
              (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
-                 (append-text info (wrap-as (append (i386:value->base size)
-                                                    (i386:accu/base))))))
+                 ;; FIXME: c&p 1158
+                 (let* ((info (allocate-register info))
+                        (info (append-text info (wrap-as (append
+                                                          (as info 'value->r size)
+                                                          (as info 'swap-r0-r1)
+                                                          (as info 'r0/r1)))))
+                        (info (append-text info (wrap-as (append (as info 'swap-r0-r1)))))
+                        (free-register info))
+                   info)))
            (let* ((info (expr->register* b info))
-                  (info (append-text info (wrap-as (append (i386:value->base size)
-                                                           (i386:accu*base)
-                                                           (i386:accu->base)))))
-                  (info (expr->register* a info)))
-             (append-text info (wrap-as (i386:accu-base)))))))
-
-    ((pre-dec ,expr)
-     (let* ((rank (expr->rank info expr))
-            (size (cond ((= rank 1) (ast-type->size info expr))
-                        ((> rank 1) 4)
-                        (else 1)))
-            (info ((expr-add info) expr (- size)))
-            (info (append (expr->register* expr info))))
-       info))
-
-    ((pre-inc ,expr)
-     (let* ((rank (expr->rank info expr))
-            (size (cond ((= rank 1) (ast-type->size info expr))
-                        ((> rank 1) 4)
-                        (else 1)))
-            (info ((expr-add info) expr size))
-            (info (append (expr->register* expr info))))
-       info))
+                  (info (allocate-register info))
+                  (info (append-text info (wrap-as (append (as info 'value->r size)
+                                                           (as info 'r0*r1)))))
+                  (info (free-register info))
+                  (info (expr->register* a info))
+                  (info (append-text info (wrap-as (append (as info 'swap-r0-r1)))))
+                  (info (append-text info (wrap-as (as info 'r0-r1))))
+                  (info (free-register info)))
+             info))))
 
     ((post-dec ,expr)
      (let* ((info (expr->register* expr info))
-            (info (append-text info (wrap-as (i386:push-accu))))
             (post (clone info #:text '()))
-            (post (append-text post (ast->comment o)))
-            (post (append-text post (wrap-as (i386:pop-base))))
-            (post (append-text post (wrap-as (i386:push-accu))))
-            (post (append-text post (wrap-as (i386:base->accu))))
+            (post (allocate-register post))
+            (post (append-text post (wrap-as (as post 'r0->r1))))
             (rank (expr->rank post expr))
+            (reg-size (->size "*" info))
             (size (cond ((= rank 1) (ast-type->size post expr))
-                        ((> rank 1) 4)
+                        ((> rank 1) reg-size)
                         (else 1)))
-            (post ((expr-add post) expr (- size)))
-            (post (append-text post (wrap-as (i386:pop-accu)))))
+            (post ((expr-add post) expr (- size))))
        (clone info #:post (.text post))))
 
     ((post-inc ,expr)
      (let* ((info (expr->register* expr info))
-            (info (append-text info (wrap-as (i386:push-accu))))
             (post (clone info #:text '()))
-            (post (append-text post (ast->comment o)))
-            (post (append-text post (wrap-as (i386:pop-base))))
-            (post (append-text post (wrap-as (i386:push-accu))))
-            (post (append-text post (wrap-as (i386:base->accu))))
+            (post (allocate-register post))
+            (post (append-text post (wrap-as (as post 'r0->r1))))
             (rank (expr->rank post expr))
+            (reg-size (->size "*" info))
             (size (cond ((= rank 1) (ast-type->size post expr))
-                        ((> rank 1) 4)
+                        ((> rank 1) reg-size)
                         (else 1)))
-            (post ((expr-add post) expr size))
-            (post (append-text post (wrap-as (i386:pop-accu)))))
+            (post ((expr-add post) expr size)))
        (clone info #:post (.text post))))
 
+    ((pre-dec ,expr)
+     (let* ((rank (expr->rank info expr))
+            (reg-size (->size "*" info))
+            (size (cond ((= rank 1) (ast-type->size info expr))
+                        ((> rank 1) reg-size)
+                        (else 1)))
+            (info ((expr-add info) expr (- size)))
+            (info (append (expr->register* expr info))))
+       info))
+
+    ((pre-inc ,expr)
+     (let* ((rank (expr->rank info expr))
+            (reg-size (->size "*" info))
+            (size (cond ((= rank 1) (ast-type->size info expr))
+                        ((> rank 1) reg-size)
+                        (else 1)))
+            (info ((expr-add info) expr size))
+            (info (append (expr->register* expr info))))
+       info))
+
     (_ (error "expr->register*: not supported: " o))))
 
 (define (expr-add info)
   (lambda (o n)
     (let* ((info (expr->register* o info))
-           (info (append-text info (wrap-as (i386:accu-mem-add n)))))
-      info)))
+           (size (ast->size o info))
+           (reg-size (->size "*" info))
+           (size (if (= size reg-size) 0 size))
+           (info (append-text info (wrap-as (append (as info
+                                                        (case size
+                                                          ((0) 'r-mem-add)
+                                                          ((1) 'r-byte-mem-add)
+                                                          ((2) 'r-word-mem-add)
+                                                          ((4) 'r-long-mem-add)) n))))))
+      (free-register info))))
 
 (define (expr->register o info)
-  ;;(stderr "expr->register o=~s\n" o)
-
-  (let ((locals (.locals info))
-        (text (.text info))
-        (globals (.globals info)))
+  (let* ((locals (.locals info))
+         (text (.text info))
+         (globals (.globals info))
+         (r-size (->size "*" info)))
 
     (define (helper)
       (pmatch o
         ((expr) info)
 
-        ((comma-expr) info)
+        ((comma-expr)
+         (allocate-register info))
 
         ((comma-expr ,a . ,rest)
-         (let ((info (expr->register a info)))
+         (let* ((info (expr->register a info))
+                (info (free-register info)))
            (expr->register `(comma-expr ,@rest) info)))
 
         ((p-expr (string ,string))
          (let* ((globals ((globals:add-string globals) string))
-                (info (clone info #:globals globals)))
-           (append-text info (list (i386:label->accu `(#:string ,string))))))
+                (info (clone info #:globals globals))
+                (info (allocate-register info)))
+           (append-text info (wrap-as (as info 'label->r `(#:string ,string))))))
 
         ((p-expr (string . ,strings))
          (let* ((string (apply string-append strings))
                 (globals ((globals:add-string globals) string))
-                (info (clone info #:globals globals)))
-           (append-text info (list (i386:label->accu `(#:string ,string))))))
+                (info (clone info #:globals globals))
+                (info (allocate-register info)))
+           (append-text info (wrap-as (as info 'label->r `(#:string ,string))))))
 
         ((p-expr (fixed ,value))
-         (let ((value (cstring->int value))
-               (info (alloc-register info)))
-           (append-text info (wrap-as (as info 'value->r0 value)))))
+         (let* ((value (cstring->int value))
+                (info (allocate-register info))
+                (info (append-text info (append (wrap-as (as info 'value->r value)))))
+                (reg-size (->size "*" info)))
+           (if (or #t (> value 0) (= reg-size 4)) info
+               (append-text info (wrap-as (as info 'long-signed-r))))))
 
         ((p-expr (float ,value))
-         (let ((value (cstring->float value)))
-           (append-text info (wrap-as (i386:value->accu value)))))
+         (let ((value (cstring->float value))
+               (info (allocate-register info)))
+           (append-text info (wrap-as (as info 'value->r value)))))
 
         ((neg (p-expr (fixed ,value)))
-         (let ((value (- (cstring->int value))))
-           (append-text info (wrap-as (i386:value->accu value)))))
+         (let* ((value (- (cstring->int value)))
+                (info (allocate-register info))
+                (info (append-text info (append (wrap-as (as info 'value->r value)))))
+                (reg-size (->size "*" info)))
+           (if (or #t (> value 0) (= reg-size 4)) info
+               (append-text info (wrap-as (as info 'long-signed-r))))))
 
         ((p-expr (char ,char))
-         (let ((char (char->integer (car (string->list char)))))
-           (append-text info (wrap-as (i386:value->accu char)))))
+         (let ((char (char->integer (car (string->list char))))
+               (info (allocate-register info)))
+           (append-text info (wrap-as (as info 'value->r char)))))
 
-        (,char (guard (char? char)) (append-text info (wrap-as (i386:value->accu char))))
+        (,char (guard (char? char))
+               (let ((info (allocate-register info)))
+                 (append-text info (wrap-as (as info 'value->r char)))))
 
         ((p-expr (ident ,name))
-         (append-text info ((ident->r0 info) name)))
+         (let ((info (allocate-register info)))
+           (append-text info ((ident->r info) name))))
 
         ((initzer ,initzer)
          (expr->register initzer info))
         ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
          (let* ((type (ast->basic-type struct info))
                 (offset (field-offset info type field))
-                (base (cstring->int base)))
-           (append-text info (wrap-as (i386:value->accu (+ base offset))))))
+                (base (cstring->int base))
+                (info (allocate-register info)))
+           (append-text info (wrap-as (as info 'value->r (+ base offset))))))
 
         ;; &foo
         ((ref-to (p-expr (ident ,name)))
-         (append-text info ((ident-address->accu info) name)))
+         (let ((info (allocate-register info)))
+           (append-text info ((ident-address->r info) name))))
 
         ;; &*foo
         ((ref-to (de-ref ,expr))
          (expr->register* expr info))
 
         ((sizeof-expr ,expr)
-         (append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
+         (let ((info (allocate-register info)))
+           (append-text info (wrap-as (as info 'value->r (ast->size expr info))))))
 
         ((sizeof-type ,type)
-         (append-text info (wrap-as (i386:value->accu (ast->size type info)))))
+         (let ((info (allocate-register info)))
+           (append-text info (wrap-as (as info 'value->r (ast->size type info))))))
 
         ((array-ref ,index ,array)
          (let* ((info (expr->register* o info))
                 (type (ast->type o info)))
-           (append-text info (mem->accu type))))
+           (append-text info (mem->r type info))))
 
         ((d-sel ,field ,struct)
          (let* ((info (expr->register* o info))
                 (info (append-text info (ast->comment o)))
                 (type (ast->type o info))
-                (size (->size type))
+                (size (->size type info))
                 (array? (c-array? type)))
            (if array? info
-               (append-text info (mem->accu type)))))
+               (append-text info (mem->r type info)))))
 
         ((i-sel ,field ,struct)
          (let* ((info (expr->register* o info))
                 (info (append-text info (ast->comment o)))
                 (type (ast->type o info))
-                (size (->size type))
+                (size (->size type info))
                 (array? (c-array? type)))
            (if array? info
-               (append-text info (mem->accu type)))))
+               (append-text info (mem->r type info)))))
 
         ((de-ref ,expr)
          (let* ((info (expr->register expr info))
                 (type (ast->type o info)))
-           (append-text info (mem->accu type))))
+           (append-text info (mem->r type info))))
 
         ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
-         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
+         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list))))
                                    (append-text info (wrap-as (asm->m1 arg0))))
-             (let* ((text-length (length text))
-                    (args-info (let loop ((expressions (reverse expr-list)) (info info))
-                                 (if (null? expressions) info
-                                     (loop (cdr expressions) ((expr->arg info) (car expressions))))))
-                    (n (length expr-list)))
-               (if (not (assoc-ref locals name))
-                   (begin
-                     (if (and (not (assoc name (.functions info)))
-                              (not (assoc name globals))
-                              (not (equal? name (.function info))))
-                         (stderr "warning: undeclared function: ~a\n" name))
-                     (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)
-                                                    (list (i386:call-accu n)))))))))
+             (let* ((info (append-text info (ast->comment o)))
+                    (info (allocate-register info))
+                    (allocated (.allocated info))
+                    (pushed (.pushed info))
+                    (registers (.registers info))
+                    (info (fold push-register info (cdr allocated)))
+                    (reg-size (->size "*" info))
+                    (info (if (cc-amd? info) (fold expr->arg info expr-list (iota (length expr-list)))
+                              (fold-right expr->arg info expr-list (reverse (iota (length expr-list))))))
+                    (info (clone info #:allocated '() #:pushed 0 #:registers (append (reverse allocated) registers)))
+                    (n (length expr-list))
+                    (info (if (not (assoc-ref locals name))
+                              (begin
+                                (when (and (not (assoc name (.functions info)))
+                                           (not (assoc name globals))
+                                           (not (equal? name (.function info))))
+                                  (stderr "warning: undeclared function: ~a\n" name))
+                                (append-text info (wrap-as (as info 'call-label name n))))
+                              (let* ((info (expr->register `(p-expr (ident ,name)) info))
+                                     (info (append-text info (wrap-as (as info 'call-r n)))))
+                                info)))
+                    (info (clone info #:allocated allocated #:pushed pushed #:registers registers))
+                    (info (if (null? (cdr allocated)) info
+                              (append-text info (wrap-as (as info 'return->r)))))
+                    (info (fold-right pop-register info (cdr allocated))))
+               info)))
 
         ((fctn-call ,function (expr-list . ,expr-list))
-         (let* ((text-length (length text))
-                (args-info (let loop ((expressions (reverse expr-list)) (info info))
-                             (if (null? expressions) info
-                                 (loop (cdr expressions) ((expr->arg info) (car expressions))))))
+         (let* ((info (append-text info (ast->comment o)))
+                (info (allocate-register info))
+                (allocated (.allocated info))
+                (pushed (.pushed info))
+                (registers (.registers info))
+                (info (fold push-register info (cdr allocated)))
+                (reg-size (->size "*" info))
+                (info (if (cc-amd? info) (fold expr->arg info expr-list (iota (length expr-list)))
+                          (fold-right expr->arg info expr-list (reverse (iota (length expr-list))))))
+                (info (fold (lambda (x info) (free-register info)) info (.allocated info)))
                 (n (length expr-list))
-                (empty (clone info #:text '()))
-                (accu (expr->register function empty)))
-           (append-text args-info (append (.text accu)
-                                          (list (i386:call-accu n))))))
+                (function (pmatch function
+                            ((de-ref ,function) function)
+                            (_ function)))
+                (info (expr->register function info))
+                (info (append-text info (wrap-as (as info 'call-r n))))
+                (info (free-register info))
+                (info (clone info #:allocated allocated #:pushed pushed #:registers registers))
+                (info (if (null? (cdr allocated)) info
+                          (append-text info (wrap-as (as info 'return->r)))))
+                (info (fold-right pop-register info (cdr allocated))))
+           info))
 
-        ((cond-expr . ,cond-expr)
-         (ast->info `(expr-stmt ,o) info))
+        ((cond-expr ,test ,then ,else)
+         (let* ((info (append-text info (ast->comment `(cond-expr ,test (ellipsis) (ellipsis)))))
+                (here (number->string (length text)))
+                (label (string-append "_" (.function info) "_" here "_"))
+                (else-label (string-append label "else"))
+                (break-label (string-append label "break"))
+                (info ((test-jump-label->info info else-label) test))
+                (info (expr->register then info))
+                (info (free-register info))
+                (info (append-text info (wrap-as (as info 'jump break-label))))
+                (info (append-text info (wrap-as `((#:label ,else-label)))))
+                (info (expr->register else info))
+                (info (free-register info))
+                (info (append-text info (wrap-as `((#:label ,break-label)))))
+                (info (allocate-register info)))
+           info))
 
         ((post-inc ,expr)
          (let* ((info (append (expr->register expr info)))
-                (info (append-text info (wrap-as (i386:push-accu))))
                 (rank (expr->rank info expr))
+                (reg-size (->size "*" info))
                 (size (cond ((= rank 1) (ast-type->size info expr))
-                            ((> rank 1) 4)
+                            ((> rank 1) reg-size)
                             (else 1)))
-                (info ((expr-add info) expr size))
-                (info (append-text info (wrap-as (i386:pop-accu)))))
+                (info ((expr-add info) expr size)))
            info))
 
         ((post-dec ,expr)
          (let* ((info (append (expr->register expr info)))
-                (info (append-text info (wrap-as (i386:push-accu))))
                 (rank (expr->rank info expr))
+                (reg-size (->size "*" info))
                 (size (cond ((= rank 1) (ast-type->size info expr))
-                            ((> rank 1) 4)
+                            ((> rank 1) reg-size)
                             (else 1)))
-                (info ((expr-add info) expr (- size)))
-                (info (append-text info (wrap-as (i386:pop-accu)))))
+                (info ((expr-add info) expr (- size))))
            info))
 
         ((pre-inc ,expr)
          (let* ((rank (expr->rank info expr))
+                (reg-size (->size "*" info))
                 (size (cond ((= rank 1) (ast-type->size info expr))
-                            ((> rank 1) 4)
+                            ((> rank 1) reg-size)
                             (else 1)))
                 (info ((expr-add info) expr size))
                 (info (append (expr->register expr info))))
 
         ((pre-dec ,expr)
          (let* ((rank (expr->rank info expr))
+                (reg-size (->size "*" info))
                 (size (cond ((= rank 1) (ast-type->size info expr))
-                            ((> rank 1) 4)
+                            ((> rank 1) reg-size)
                             (else 1)))
                 (info ((expr-add info) expr (- size)))
                 (info (append (expr->register expr info))))
          (let* ((rank (expr->rank info a))
                 (type (ast->basic-type a info))
                 (struct? (structured-type? type))
+                (reg-size (->size "*" info))
                 (size (cond ((= rank 1) (ast-type->size info a))
-                            ((> rank 1) 4)
-                            ((and struct? (= rank 2)) 4)
+                            ((> rank 1) reg-size)
+                            ((and struct? (= rank 2)) reg-size)
                             (else 1)))
                 (info (expr->register a info))
                 (value (cstring->int value))
                 (value (* size value)))
-           (append-text info (wrap-as (i386:accu+value value)))))
+           (append-text info (wrap-as (as info 'r+value value)))))
 
         ((add ,a ,b)
          (let* ((rank (expr->rank info a))
                 (rank-b (expr->rank info b))
                 (type (ast->basic-type a info))
                 (struct? (structured-type? type))
+                (reg-size (->size "*" info))
                 (size (cond ((= rank 1) (ast-type->size info a))
-                            ((> rank 1) 4)
-                            ((and struct? (= rank 2)) 4)
+                            ((> rank 1) reg-size)
+                            ((and struct? (= rank 2)) reg-size)
                             (else 1))))
-           (if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
+           (if (or (= size 1)) ((binop->r info) a b 'r0+r1)
                (let* ((info (expr->register b info))
-                      (info (append-text info (wrap-as (append (i386:value->base size)
-                                                               (i386:accu*base)
-                                                               (i386:accu->base)))))
-                      (info (expr->register a info)))
-                 (append-text info (wrap-as (i386:accu+base)))))))
+                      (info (allocate-register info))
+                      (info (append-text info (wrap-as (append (as info 'value->r size)
+                                                               (as info 'r0*r1)))))
+                      (info (free-register info))
+                      (info (expr->register a info))
+                      (info (append-text info (wrap-as (as info 'r0+r1))))
+                      (info (free-register info)))
+                 info))))
 
         ((sub ,a (p-expr (fixed ,value)))
          (let* ((rank (expr->rank info a))
                 (type (ast->basic-type a info))
                 (struct? (structured-type? type))
-                (size (->size type))
+                (size (->size type info))
+                (reg-size (->size "*" info))
                 (size (cond ((= rank 1) size)
-                            ((> rank 1) 4)
-                            ((and struct? (= rank 2)) 4)
+                            ((> rank 1) reg-size)
+                            ((and struct? (= rank 2)) reg-size)
                             (else 1)))
                 (info (expr->register a info))
                 (value (cstring->int value))
                 (value (* size value)))
-           (append-text info (wrap-as (i386:accu+value (- value))))))
+           (append-text info (wrap-as (as info 'r+value (- value))))))
 
         ((sub ,a ,b)
          (let* ((rank (expr->rank info a))
                 (rank-b (expr->rank info b))
                 (type (ast->basic-type a info))
                 (struct? (structured-type? type))
-                (size (->size type))
+                (size (->size type info))
+                (reg-size (->size "*" info))
                 (size  (cond ((= rank 1) size)
-                             ((> rank 1) 4)
-                             ((and struct? (= rank 2)) 4)
+                             ((> rank 1) reg-size)
+                             ((and struct? (= rank 2)) reg-size)
                              (else 1))))
+
            (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
-               (let ((info ((binop->accu info) a b (i386:accu-base))))
+               (let ((info ((binop->r info) a b 'r0-r1)))
                  (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
-                     (append-text info (wrap-as (append (i386:value->base size)
-                                                        (i386:accu/base))))))
+                     ;; FIXME: c&p 792
+                     (let* ((info (allocate-register info))
+                            (info (append-text info (wrap-as (append (as info 'value->r size)
+                                                                     (as info 'r0/r1)))))
+                            (info (free-register info)))
+                       info)))
                (let* ((info (expr->register b info))
-                      (info (append-text info (wrap-as (append (i386:value->base size)
-                                                               (i386:accu*base)
-                                                               (i386:accu->base)))))
-                      (info (expr->register a info)))
-                 (append-text info (wrap-as (i386:accu-base)))))))
-
-        ((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
+                      (info (allocate-register info))
+                      (info (append-text info (wrap-as (append (as info 'value->r size)
+                                                               (as info 'r0*r1)))))
+                      (info (free-register info))
+                      (info (expr->register a info))
+                      (info (append-text info (wrap-as (append (as info 'swap-r0-r1)))))
+                      (info (append-text info (wrap-as (as info 'r0-r1))))
+                      (info (free-register info)))
+                 info))))
+
+        ((bitwise-and ,a ,b) ((binop->r info) a b 'r0-and-r1))
         ((bitwise-not ,expr)
-         (let ((info (ast->info expr info)))
-           (append-text info (wrap-as (i386:accu-not)))))
-        ((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
-        ((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
-        ((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
-        ((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
-        ((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
-        ((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
-        ((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
+         (let ((info (expr->register expr info)))
+           (append-text info (wrap-as (as info 'not-r)))))
+        ((bitwise-or ,a ,b) ((binop->r info) a b 'r0-or-r1))
+        ((bitwise-xor ,a ,b) ((binop->r info) a b 'r0-xor-r1))
+        ((lshift ,a ,b) ((binop->r info) a b 'r0<<r1))
+        ((rshift ,a ,b) ((binop->r info) a b 'r0>>r1))
+        ((div ,a ,b) ((binop->r info) a b 'r0/r1))
+        ((mod ,a ,b) ((binop->r info) a b 'r0%r1))
+        ((mul ,a ,b) ((binop->r info) a b 'r0*r1))
 
         ((not ,expr)
-         (let* ((test-info (ast->info expr info)))
-           (clone info #:text
-                  (append (.text test-info)
-                          (wrap-as (i386:accu-negate)))
-                  #:globals (.globals test-info))))
+         (let* ((info (expr->register expr info))
+                (info (append-text info (wrap-as (as info 'test-r))))
+                (info (append-text info (wrap-as (as info 'r-negate)))))
+           (append-text info (wrap-as (as info 'test-r))))) ;; hmm, use ast->info?
 
         ((neg ,expr)
-         (let ((info (expr->base expr info)))
-           (append-text info (append (wrap-as (i386:value->accu 0))
-                                     (wrap-as (i386:sub-base))))))
+         (let* ((info (expr->register expr info))
+                (info (allocate-register info))
+                (info (append-text info (append (wrap-as (as info 'value->r 0))
+                                                (wrap-as (as info 'swap-r0-r1))
+                                                (wrap-as (as info 'r0-r1)))))
+                (info (free-register info)))
+           info))
 
-        ((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
+        ((eq ,a ,b) (let ((info ((binop->r info) a b 'r0-r1)))
+                      (append-text info (wrap-as (as info 'zf->r)))))
 
         ((ge ,a ,b)
          (let* ((type-a (ast->type a info))
                 (type-b (ast->type b info))
-                (test->accu (if (or (unsigned? type-a) (unsigned? type-b)) i386:ae?->accu i386:ge?->accu)))
-           ((binop->accu info) a b (append (i386:sub-base) (test->accu) (i386:accu-test)))))
+                (info ((binop->r info) a b 'r0-r1))
+                (test->r (if (or (unsigned? type-a) (unsigned? type-b)) 'ae?->r 'ge?->r))
+                (info (append-text info (wrap-as (as info test->r))))
+                (info (append-text info (wrap-as (as info 'test-r)))))
+           info))
 
         ((gt ,a ,b)
          (let* ((type-a (ast->type a info))
                 (type-b (ast->type b info))
-                (test->accu (if (or (unsigned? type-a) (unsigned? type-b)) i386:a?->accu i386:g?->accu)))
-           ((binop->accu info) a b (append (i386:sub-base) (test->accu) (i386:accu-test)))))
-
-        ;; FIXME: set accu *and* flags
-        ((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
-                                                    (i386:sub-base)
-                                                    (i386:nz->accu)
-                                                    (i386:accu<->stack)
-                                                    (i386:sub-base)
-                                                    (i386:xor-zf)
-                                                    (i386:pop-accu))))
+                (info ((binop->r info) a b 'r0-r1))
+                (test->r (if (or (unsigned? type-a) (unsigned? type-b)) 'a?->r 'g?->r))
+                (info (append-text info (wrap-as (as info test->r))))
+                (info (append-text info (wrap-as (as info 'test-r)))))
+           info))
 
-        ((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
+        ((ne ,a ,b) (let* ((info ((binop->r info) a b 'r0-r1))
+                           (info (append-text info (wrap-as (as info 'test-r))))
+                           (info (append-text info (wrap-as (as info 'xor-zf))))
+                           (info (append-text info (wrap-as (as info 'zf->r)))))
+                      info))
 
         ((le ,a ,b)
          (let* ((type-a (ast->type a info))
                 (type-b (ast->type b info))
-                (test->accu (if (or (unsigned? type-a) (unsigned? type-b)) i386:be?->accu i386:le?->accu)))
-           ((binop->accu info) a b (append (i386:sub-base) (test->accu) (i386:accu-test)))))
+                (info ((binop->r info) a b 'r0-r1))
+                (test->r (if (or (unsigned? type-a) (unsigned? type-b)) 'be?->r 'le?->r))
+                (info (append-text info (wrap-as (as info test->r))))
+                (info (append-text info (wrap-as (as info 'test-r)))))
+           info))
 
         ((lt ,a ,b)
          (let* ((type-a (ast->type a info))
                 (type-b (ast->type b info))
-                (test->accu (if (or (unsigned? type-a) (unsigned? type-b)) i386:b?->accu i386:l?->accu)))
-           ((binop->accu info) a b (append (i386:sub-base) (test->accu) (i386:accu-test)))))
+                (info ((binop->r info) a b 'r0-r1))
+                (test->r (if (or (unsigned? type-a) (unsigned? type-b)) 'b?->r 'l?->r))
+                (info (append-text info (wrap-as (as info test->r))))
+                (info (append-text info (wrap-as (as info 'test-r)))))
+           info))
 
         ((or ,a ,b)
          (let* ((info (expr->register a info))
                 (here (number->string (length (.text info))))
                 (skip-b-label (string-append "_" (.function info) "_" here "_or_skip_b"))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
-                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as (as info 'test-r))))
+                (info (append-text info (wrap-as (as info 'jump-nz skip-b-label))))
+                (info (append-text info (wrap-as (as info 'test-r))))
+                (info (free-register info))
                 (info (expr->register b info))
-                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as (as info 'test-r))))
                 (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
            info))
 
          (let* ((info (expr->register a info))
                 (here (number->string (length (.text info))))
                 (skip-b-label (string-append "_" (.function info) "_" here "_and_skip_b"))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info (append-text info (wrap-as (i386:jump-z skip-b-label))))
-                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as (as info 'test-r))))
+                (info (append-text info (wrap-as (as info 'jump-z skip-b-label))))
+                (info (append-text info (wrap-as (as info 'test-r))))
+                (info (free-register info))
                 (info (expr->register b info))
-                (info (append-text info (wrap-as (i386:accu-test))))
+                (info (append-text info (wrap-as (as info 'test-r))))
                 (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
            info))
 
         ((cast ,type ,expr)
          (let ((info (expr->register expr info))
                (type (ast->type o info)))
-           (append-text info (convert-accu type))))
+           (append-text info (convert-r0 info type))))
 
         ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
          (let* ((info (expr->register `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
                 (type (ident->type info name))
                 (rank (ident->rank info name))
-                (size (if (> rank 1) 4 1)))
+                (reg-size (->size "*" info))
+                (size (if (> rank 1) reg-size 1)))
            (append-text info ((ident-add info) name size))))
 
         ((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
          (let* ((info (expr->register `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
                 (type (ident->type info name))
                 (rank (ident->rank info name))
-                (size (if (> rank 1) 4 1)))
+                (reg-size (->size "*" info))
+                (size (if (> rank 1) reg-size 1)))
            (append-text info ((ident-add info) name (- size)))))
 
         ((assn-expr ,a (op ,op) ,b)
                 (rank (->rank type))
                 (type-b (ast->type b info))
                 (rank-b (->rank type-b))
-                (size (if (zero? rank) (->size type) 4))
-                (size-b (if (zero? rank-b) (->size type-b) 4))
+                (reg-size (->size "*" info))
+                (size (if (zero? rank) (->size type info) reg-size))
+                (size-b (if (zero? rank-b) (->size type-b info) reg-size))
                 (info (expr->register b info))
                 (info (if (equal? op "=") info
                           (let* ((struct? (structured-type? type))
                                  (size (cond ((= rank 1) (ast-type->size info a))
-                                             ((> rank 1) 4)
-                                             ((and struct? (= rank 2)) 4)
+                                             ((> rank 1) reg-size)
+                                             ((and struct? (= rank 2)) reg-size)
                                              (else 1)))
                                  (info (if (or (= size 1) (= rank-b 1)) info
-                                           (let ((info (append-text info (wrap-as (i386:value->base size)))))
-                                             (append-text info (wrap-as (i386:accu*base))))))
-                                 (info (append-text info (wrap-as (i386:push-accu))))
+                                           (let* ((info (allocate-register info))
+                                                  (info (append-text info (wrap-as (as info 'value->r size))))
+                                                  (info (append-text info (wrap-as (as info 'r0*r1))))
+                                                  (info (free-register info)))
+                                             info)))
                                  (info (expr->register a info))
-                                 (info (append-text info (wrap-as (i386:pop-base))))
-                                 (info (append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
-                                                               ((equal? op "-=") (wrap-as (i386:accu-base)))
-                                                               ((equal? op "*=") (wrap-as (i386:accu*base)))
-                                                               ((equal? op "/=") (wrap-as (i386:accu/base)))
-                                                               ((equal? op "%=") (wrap-as (i386:accu%base)))
-                                                               ((equal? op "&=") (wrap-as (i386:accu-and-base)))
-                                                               ((equal? op "|=") (wrap-as (i386:accu-or-base)))
-                                                               ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
-                                                               ((equal? op ">>=") (wrap-as (i386:accu>>base)))
-                                                               ((equal? op "<<=") (wrap-as (i386:accu<<base)))
-                                                               (else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
+                                 (info (append-text info (wrap-as (as info 'swap-r0-r1))))
+                                 (info (append-text info (cond ((equal? op "+=") (wrap-as (as info 'r0+r1)))
+                                                               ((equal? op "-=") (wrap-as (as info 'r0-r1)))
+                                                               ((equal? op "*=") (wrap-as (as info 'r0*r1)))
+                                                               ((equal? op "/=") (wrap-as (as info 'r0/r1)))
+                                                               ((equal? op "%=") (wrap-as (as info 'r0%r1)))
+                                                               ((equal? op "&=") (wrap-as (as info 'r0-and-r1)))
+                                                               ((equal? op "|=") (wrap-as (as info 'r0-or-r1)))
+                                                               ((equal? op "^=") (wrap-as (as info 'r0-xor-r1)))
+                                                               ((equal? op ">>=") (wrap-as (as info 'r0>>r1)))
+                                                               ((equal? op "<<=") (wrap-as (as info 'r0<<r1)))
+                                                               (else (error (format #f "mescc: op ~a not supported: ~a\n" op o))))))
+                                 (info (free-register info)))
                             (cond ((not (and (= rank 1) (= rank-b 1))) info)
-                                  ((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
-                                                                                       (i386:accu/base)))))
+                                  ((equal? op "-=") (let* ((info (allocate-register info))
+                                                           (info (append-text info (wrap-as (append (as info 'value->r size)
+                                                                                                    (as info 'r0/r1)))))
+                                                           (info (free-register info)))
+                                                      info))
                                   (else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
            (when (and (equal? op "=")
                       (not (= size size-b))
                       (not (and (or (= size 1) (= size 2))
-                                (or (= size-b 2) (= size-b 4))))
+                                (or (= size-b 2) (= size-b reg-size))))
                       (not (and (= size 2)
-                                (= size-b 4)))
-                      (not (and (= size 4)
+                                (= size-b reg-size)))
+                      (not (and (= size reg-size)
                                 (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))
            (pmatch a
              ((p-expr (ident ,name))
-              (if (or (<= size 4) ;; FIXME: long long = int
-                      (<= 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)))
+              (if (or (<= size r-size)
+                      (<= size-b r-size)) (append-text info ((r->ident info) name))
+                      (let* ((info (expr->register* a info))
+                             (info (r0->r1-mem*n info size size-b)))
                         (free-register info))))
-             (_ (let* ((info (expr->base* a info))
+
+             (_ (let* ((info (expr->register* a info))
+                       (reg-size (->size "*" info))
                        (info (if (not (bit-field? type)) info
                                  (let* ((bit (bit-field:bit type))
                                         (bits (bit-field:bits type))
                                         (set-mask (- (ash bits 1) 1))
                                         (shifted-set-mask (ash set-mask bit))
-                                        (clear-mask (logxor shifted-set-mask #b11111111111111111111111111111111))
-                                        (info (append-text info (wrap-as (i386:push-base))))
-                                        (info (append-text info (wrap-as (i386:push-accu))))
-
-                                        (info (append-text info (wrap-as (i386:base-mem->accu))))
-                                        (info (append-text info (wrap-as (i386:accu-and clear-mask))))
-                                        (info (append-text info (wrap-as (i386:accu->base))))
-
-                                        (info (append-text info (wrap-as (i386:pop-accu))))
-                                        (info (append-text info (wrap-as (i386:accu-and set-mask))))
-                                        (info (append-text info (wrap-as (i386:accu-shl bit))))
-                                        (info (append-text info (wrap-as (i386:accu-or-base))))
-
-                                        (info (append-text info (wrap-as (i386:pop-base)))))
-                                   info))))
-                  (accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int
-
+                                        (clear-mask (logxor shifted-set-mask
+                                                            (if (= reg-size 4)
+                                                                #b11111111111111111111111111111111
+                                                                #b1111111111111111111111111111111111111111111111111111111111111111)))
+
+                                        (info (append-text info (wrap-as (as info 'swap-r0-r1))))
+                                        (info (allocate-register info))
+                                        (info (append-text info (wrap-as (as info 'r2->r0))))
+                                        (info (append-text info (wrap-as (as info 'swap-r0-r1))))
+                                        (info (append-text info (wrap-as (as info 'mem->r))))
+                                        (info (append-text info (wrap-as (as info 'r-and clear-mask))))
+                                        (info (append-text info (wrap-as (as info 'swap-r0-r1))))
+                                        (info (append-text info (wrap-as (as info 'r-and set-mask))))
+                                        (info (append-text info (wrap-as (as info 'shl-r bit))))
+                                        (info (append-text info (wrap-as (as info 'r0-or-r1))))
+                                        (info (free-register info))
+                                        (info (append-text info (wrap-as (as info 'swap-r0-r1)))))
+                                   info)))
+                       (info (r0->r1-mem*n info
+                                           (min size (max reg-size size-b))
+                                           (min size (max reg-size size-b))))
+                       (info (free-register info)))
+                  info)))))
         (_ (error "expr->register: not supported: " o))))
 
     (let ((info (helper)))
       (if (null? (.post info)) info
           (append-text (clone info #:post '()) (.post info))))))
 
-(define (mem->accu type)
-  (let ((size (->size type)))
+(define (mem->r type info)
+  (let* ((size (->size type info))
+         (reg-size (->size "*" info))
+         (size (if (= size reg-size) 0 size)))
     (case size
-      ((1) (append (wrap-as (i386:byte-mem->accu)) (convert-accu type)))
-      ((2) (append (wrap-as (i386:word-mem->accu)) (convert-accu type)))
-      ((4) (wrap-as (i386:mem->accu)))
+      ((0) (wrap-as (as info 'mem->r)))
+      ((1) (append (wrap-as (as info 'byte-mem->r)) (convert-r0 info type)))
+      ((2) (append (wrap-as (as info 'word-mem->r)) (convert-r0 info type)))
+      ((4) (append (wrap-as (as info 'long-mem->r)) (convert-r0 info type)))
       (else '()))))
 
-(define (convert-accu 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 (convert-r0 info type)
   (if (not (type? type)) '()
       (let ((sign (signed? type))
-            (size (->size type)))
+            (size (->size type info))
+            (reg-size (->size "*" info)))
         (cond ((and (= size 1) sign)
-               (wrap-as (i386:signed-byte-accu)))
+               (wrap-as (as info 'byte-signed-r)))
               ((= size 1)
-               (wrap-as (i386:byte-accu)))
+               (wrap-as (as info 'byte-r)))
               ((and (= size 2) sign)
-               (wrap-as (i386:signed-word-accu)))
+               (wrap-as (as info 'word-signed-r)))
               ((= size 1)
-               (wrap-as (i386:word-accu)))
+               (wrap-as (as info 'word-r)))
+              ((and (> reg-size 4) (= size 4) sign)
+               (wrap-as (as info 'long-signed-r)))
+              ((and (> reg-size 4) (= size 4))
+               (wrap-as (as info 'long-signed-r)))
               (else '())))))
 
-(define (expr->base o info)
-  (let* ((info (append-text info (wrap-as (i386:push-accu))))
-         (info (expr->register o info))
-         (info (append-text info (wrap-as (append (i386:accu->base) (i386:pop-accu))))))
-    info))
-
-(define (binop->accu info)
+(define (binop->r info)
   (lambda (a b c)
     (let* ((info (expr->register a info))
-           (info (expr->base b info)))
-      (append-text info (wrap-as c)))))
+           (info (expr->register b info))
+           (info (append-text info (wrap-as (as info c)))))
+      (free-register info))))
 
-(define (binop->accu* info)
+(define (binop->r* info)
   (lambda (a b c)
     (let* ((info (expr->register* a info))
-           (info (expr->base b info)))
-      (append-text info (wrap-as c)))))
+           (info (expr->register b info))
+           (info (append-text info (wrap-as (as info c)))))
+      (free-register info))))
 
 (define (wrap-as o . annotation)
   `(,@annotation ,o))
 
-(define (expr->base* o info)
-  (let* ((info (append-text info (wrap-as (i386:push-accu))))
-         (info (expr->register* o info))
-         (info (append-text info (wrap-as (i386:accu->base))))
-         (info (append-text info (wrap-as (i386:pop-accu)))))
-    info))
-
 (define (comment? o)
   (and (pair? o) (pair? (car o)) (eq? (caar o) #:comment)))
 
 (define (test-jump-label->info info label)
   (define (jump type . test)
     (lambda (o)
-      (let* ((info (ast->info o info))
+      (let* ((info (expr->register o info))
              (info (append-text info (make-comment "jmp test LABEL")))
-             (jump-text (wrap-as (type label))))
-        (append-text info (append (if (null? test) '() (car test))
-                                  jump-text)))))
+             (jump-text (wrap-as (as info type label)))
+             (info (append-text info (append (if (null? test) '() ((car test) info))
+                                             jump-text)))
+             (info (free-register info)))
+        info)))
   (lambda (o)
     (pmatch o
       ((expr) info)
-      ((le ,a ,b) ((jump i386:jump-z) o))
-      ((lt ,a ,b) ((jump i386:jump-z) o))
-      ((ge ,a ,b) ((jump i386:jump-z) o))
-      ((gt ,a ,b) ((jump i386:jump-z) o))
-      ((ne ,a ,b) ((jump i386:jump-nz) o))
-      ((eq ,a ,b) ((jump i386:jump-nz) o))
-      ((not _) ((jump i386:jump-z) o))
+      ((le ,a ,b) ((jump 'jump-z) o))
+      ((lt ,a ,b) ((jump 'jump-z) o))
+      ((ge ,a ,b) ((jump 'jump-z) o))
+      ((gt ,a ,b) ((jump 'jump-z) o))
+      ((ne ,a ,b) ((jump 'jump-nz) o))
+      ((eq ,a ,b) ((jump 'jump-nz) o))
+      ((not _) ((jump 'jump-z) o))
 
       ((and ,a ,b)
        (let* ((info ((test-jump-label->info info label) a))
               (skip-b-label (string-append label "_skip_b_" here))
               (b-label (string-append label "_b_" here))
               (info ((test-jump-label->info info b-label) a))
-              (info (append-text info (wrap-as (i386:jump skip-b-label))))
+              (info (append-text info (wrap-as (as info 'jump skip-b-label))))
               (info (append-text info (wrap-as `((#:label ,b-label)))))
               (info ((test-jump-label->info info label) b))
               (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
          info))
 
       ((array-ref ,index ,expr) (let* ((rank (expr->rank info expr))
+                                       (reg-size (->size "*" info))
                                        (size (if (= rank 1) (ast-type->size info expr)
-                                                 4)))
-                                  ((jump (if (= size 1) i386:jump-byte-z
-                                             i386:jump-z)
-                                         (wrap-as (as info 'r0-zero?))) o)))
+                                                 reg-size)))
+                                  ((jump (if (= size 1) 'jump-byte-z
+                                             'jump-z)
+                                         (lambda (info) (wrap-as (as info 'r-zero?)))) o)))
 
       ((de-ref ,expr) (let* ((rank (expr->rank info expr))
+                             (r-size (->size "*" info))
                              (size (if (= rank 1) (ast-type->size info expr)
-                                       4)))
-                        ((jump (if (= size 1) i386:jump-byte-z
-                                   i386:jump-z)
-                               (wrap-as (as info 'r0-zero?))) o)))
+                                       r-size)))
+                        ((jump (if (= size 1) 'jump-byte-z
+                                   'jump-z)
+                               (lambda (info) (wrap-as (as info 'r-zero?)))) o)))
 
       ((assn-expr (p-expr (ident ,name)) ,op ,expr)
-       ((jump i386:jump-z
-              (append ((ident->accu info) name)
-                      (wrap-as (as info 'r0-zero?)))) o))
+       ((jump 'jump-z
+              (lambda (info)
+                (append ((ident->r info) name)
+                        (wrap-as (as info 'r-zero?))))) o))
 
-      (_ ((jump i386:jump-z (wrap-as (as info 'r0-zero?))) o)))))
+      (_ ((jump 'jump-z (lambda (info) (wrap-as (as info 'r-zero?)))) o)))))
 
 (define (cstring->int o)
   (let ((o (cond ((string-suffix? "ULL" o) (string-drop-right o 3))
     ((sub ,a ,b)
      (- (expr->number info a) (expr->number info b)))
     ((sizeof-type ,type)
-     (->size (ast->type type info)))
+     (->size (ast->type type info) info))
     ((sizeof-expr ,expr)
-     (->size (ast->type expr info)))
+     (->size (ast->type expr info) info))
     ((lshift ,x ,y)
      (ash (expr->number info x) (expr->number info y)))
     ((rshift ,x ,y)
     (_  #f)))
 
 (define (expr->number info o)
-  (or (try-expr->number info  o)
+  (or (try-expr->number info o)
       (error (format #f "expr->number: not supported: ~s\n" o))))
 
 (define (p-expr->bool info o)
   (lambda (o)
     (pmatch o
       ((comp-decl (decl-spec-list (type-spec (enum-def (ident ,name) (enum-def-list . ,fields)))) (comp-declr-list . ,decls))
-       (let (
-             ;;(constants (enum-def-list->constants (.constants info) fields))
-             ;;(type-entry (enum->type-entry name fields))
-             )
-         (append-map (lambda (o)
-                       ((struct-field info) `(comp-decl (decl-spec-list (type-spec "int")) (comp-declr-list ,o))))
-                     decls)))
-    ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (ident ,name))))
+       (append-map (lambda (o)
+                     ((struct-field info) `(comp-decl (decl-spec-list (type-spec "int")) (comp-declr-list ,o))))
+                   decls))
+      ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (ident ,name))))
        (list (cons name (ast->type type info))))
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (ptr-declr ,pointer (ident ,name)))))
        (let ((rank (pointer->rank pointer)))
          (list (cons name (make-c-array (ast->type type info) count)))))
       ((comp-decl (decl-spec-list (type-spec (struct-def (field-list . ,fields)))))
        (let ((fields (append-map (struct-field info) fields)))
-         (list (cons 'struct (make-type 'struct (apply + (map field:size fields)) fields)))))
+         (list (cons 'struct (make-type 'struct (apply + (map (cut field:size <> info) fields)) fields)))))
       ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
        (let ((fields (append-map (struct-field info) fields)))
-         (list (cons 'union (make-type 'union (apply + (map field:size fields)) fields)))))
+         (list (cons 'union (make-type 'union (apply + (map (cut field:size <> info) fields)) fields)))))
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (bit-field (ident ,name) (p-expr (fixed ,bits)))) . ,fields))
        (let ((type (ast->type type info)))
          (list (cons 'bits (let loop ((o `((comp-declr (bit-field (ident ,name) (p-expr (fixed ,bits)))) . ,fields)) (bit 0))
     (_ (error "ptr-declr->rank not supported: " o))))
 
 (define (ast->info o info)
-  ;; (stderr "ast->info o=~s\n" o)
   (let ((functions (.functions info))
         (globals (.globals info))
         (locals (.locals info))
 
       ((break)
        (let ((label (car (.break info))))
-         (append-text info (wrap-as (i386:jump label)))))
+         (append-text info (wrap-as (as info 'jump label)))))
 
       ((continue)
        (let ((label (car (.continue info))))
-         (append-text info (wrap-as (i386:jump label)))))
+         (append-text info (wrap-as (as info 'jump label)))))
 
       ;; FIXME: expr-stmt wrapper?
       (trans-unit info)
       ((expr-stmt) info)
 
-      ((compd-stmt (block-item-list . ,_)) (ast-list->info _ info))
+      ((compd-stmt (block-item-list . ,_))
+       (let* ((locals (.locals info))
+              (info (ast-list->info _ info)))
+         (clone info #:locals locals)))
 
       ((asm-expr ,gnuc (,null ,arg0 . string))
        (append-text info (wrap-as (asm->m1 arg0))))
       ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
        (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list))))
                                  (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 (as info 'r0-zero?))))))
+           (let* ((info (expr->register `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) info))
+                  (info (free-register info))
+                  (info (append-text info (wrap-as (as info 'r-zero?)))))
+             info)))
 
       ((if ,test ,then)
        (let* ((info (append-text info (ast->comment `(if ,test (ellipsis)))))
               (else-label (string-append label "else"))
               (info ((test-jump-label->info info break-label) test))
               (info (ast->info then info))
-              (info (append-text info (wrap-as (i386:jump break-label))))
+              (info (append-text info (wrap-as (as info 'jump break-label))))
               (info (append-text info (wrap-as `((#:label ,break-label))))))
          (clone info
                 #:locals locals)))
               (else-label (string-append label "else"))
               (info ((test-jump-label->info info else-label) test))
               (info (ast->info then info))
-              (info (append-text info (wrap-as (i386:jump break-label))))
+              (info (append-text info (wrap-as (as info 'jump break-label))))
               (info (append-text info (wrap-as `((#:label ,else-label)))))
               (info (ast->info else info))
               (info (append-text info (wrap-as `((#:label ,break-label))))))
 
       ;; Hmm?
       ((expr-stmt (cond-expr ,test ,then ,else))
-       (let* ((info (append-text info (ast->comment `(cond-expr ,test (ellipsis) (ellipsis)))))
-              (here (number->string (length text)))
-              (label (string-append "_" (.function info) "_" here "_"))
-              (else-label (string-append label "else"))
-              (break-label (string-append label "break"))
-              (info ((test-jump-label->info info else-label) test))
-              (info (ast->info then info))
-              (info (append-text info (wrap-as (i386:jump break-label))))
-              (info (append-text info (wrap-as `((#:label ,else-label)))))
-              (info (ast->info else info))
-              (info (append-text info (wrap-as `((#:label ,break-label))))))
-         info))
+       (let ((info (expr->register `(cond-expr ,test ,then ,else) info)))
+         (free-register info)))
 
       ((switch ,expr (compd-stmt (block-item-list . ,statements)))
        (define (clause? o)
               (last-clause-label (string-append label "clause" (number->string count)))
               (default-label (string-append label "default"))
               (info (if (not default?) info
-                        (append-text info (wrap-as (i386:jump break-label)))))
+                        (append-text info (wrap-as (as info 'jump break-label)))))
               (info (append-text info (wrap-as `((#:label ,last-clause-label)))))
               (info (if (not default?) info
-                        (append-text info (wrap-as (i386:jump default-label)))))
+                        (append-text info (wrap-as (as info 'jump default-label)))))
               (info (append-text info (wrap-as `((#:label ,break-label))))))
          (clone info
                 #:locals locals
               (info (ast->info init info))
               (info (clone info #:break (cons break-label (.break info))))
               (info (clone info #:continue (cons continue-label (.continue info))))
-              (info (append-text info (wrap-as (i386:jump initial-skip-label))))
+              (info (append-text info (wrap-as (as info 'jump initial-skip-label))))
               (info (append-text info (wrap-as `((#:label ,loop-label)))))
               (info (ast->info body info))
               (info (append-text info (wrap-as `((#:label ,continue-label)))))
-              (info (expr->register step info))
+              (info (if (equal? step '(expr)) info
+                        (let ((info (expr->register step info)))
+                          (free-register info))))
               (info (append-text info (wrap-as `((#:label ,initial-skip-label)))))
               (info ((test-jump-label->info info break-label) test))
-              (info (append-text info (wrap-as (i386:jump loop-label))))
+              (info (append-text info (wrap-as (as info 'jump loop-label))))
               (info (append-text info (wrap-as `((#:label ,break-label))))))
          (clone info
                 #:locals locals
               (break-label (string-append label "break"))
               (loop-label (string-append label "loop"))
               (continue-label (string-append label "continue"))
-              (info (append-text info (wrap-as (i386:jump continue-label))))
+              (info (append-text info (wrap-as (as info 'jump continue-label))))
               (info (clone info #:break (cons break-label (.break info))))
               (info (clone info #:continue (cons continue-label (.continue info))))
               (info (append-text info (wrap-as `((#:label ,loop-label)))))
               (info (ast->info body info))
               (info (append-text info (wrap-as `((#:label ,continue-label)))))
               (info ((test-jump-label->info info break-label) test))
-              (info (append-text info (wrap-as (i386:jump loop-label))))
+              (info (append-text info (wrap-as (as info 'jump loop-label))))
               (info (append-text info (wrap-as `((#:label ,break-label))))))
          (clone info
                 #:locals locals
               (info (ast->info body info))
               (info (append-text info (wrap-as `((#:label ,continue-label)))))
               (info ((test-jump-label->info info break-label) test))
-              (info (append-text info (wrap-as (i386:jump loop-label))))
+              (info (append-text info (wrap-as (as info 'jump loop-label))))
               (info (append-text info (wrap-as `((#:label ,break-label))))))
          (clone info
                 #:locals locals
          (ast->info statement info)))
 
       ((goto (ident ,label))
-       (append-text info (wrap-as (i386:jump (string-append "_" (.function info) "_label_" label)))))
+       (append-text info (wrap-as (as info 'jump (string-append "_" (.function info) "_label_" label)))))
+
+      ((return (expr))
+       (let ((info (fold (lambda (x info) (free-register info)) info (.allocated info))))
+         (append-text info (append (wrap-as (as info 'ret))))))
 
       ((return ,expr)
-       (let ((info (expr->register expr info)))
+       (let* ((info (fold (lambda (x info) (free-register info)) info (.allocated info)))
+              (info (expr->register expr info))
+              (info (free-register info)))
          (append-text info (append (wrap-as (as info 'ret))))))
 
       ((decl . ,decl)
-       ;;FIXME: ridiculous performance hit with mes
-       ;; Nyacc 0.80.42: missing  (enum-ref (ident "fred"))
-       (let ( ;;(info (append-text info (ast->comment o)))
-             )
+       (let ((info (append-text info (ast->comment o))))
          (decl->info info decl)))
-      ;; ...
-      ((gt . _) (expr->register o info))
-      ((ge . _) (expr->register o info))
-      ((ne . _) (expr->register o info))
-      ((eq . _) (expr->register o info))
-      ((le . _) (expr->register o info))
-      ((lt . _) (expr->register o info))
-      ((lshift . _) (expr->register o info))
-      ((rshift . _) (expr->register o info))
-
-      ;; EXPR
+
+      ((gt . _) (free-register (expr->register o info)))
+      ((ge . _) (free-register (expr->register o info)))
+      ((ne . _) (free-register (expr->register o info)))
+      ((eq . _) (free-register (expr->register o info)))
+      ((le . _) (free-register (expr->register o info)))
+      ((lt . _) (free-register (expr->register o info)))
+      ((lshift . _) (free-register (expr->register o info)))
+      ((rshift . _) (free-register (expr->register o info)))
+
       ((expr-stmt ,expression)
        (let* ((info (expr->register expression info))
-              (info (append-text info (wrap-as (as info 'r0-zero?)))))
-         (free-register info)))
+              (info (append-text info (wrap-as (as info 'r-zero?)))))
+         (fold (lambda (x info) (free-register info)) info (.allocated info))))
 
-      ;; FIXME: why do we get (post-inc ...) here
-      ;; (array-ref
-      (_ (let ((info (expr->register o info)))
-           (append-text info (wrap-as (as info 'r0-zero?))))))))
+      (_ (let* ((info (expr->register o info))
+                (info (append-text info (wrap-as (as info 'r-zero?)))))
+           (fold (lambda (x info) (free-register info)) info (.allocated info)))))))
 
 (define (ast-list->info o info)
   (fold ast->info info o))
   (let* ((i-string (number->string i))
          (i+1-string (number->string (1+ i)))
          (body-label (string-append label "body" i-string))
+         (next-body-label (string-append label "body" i+1-string))
          (clause-label (string-append label "clause" i-string))
          (last? (= i count))
          (break-label (string-append label "break"))
          (next-clause-label (string-append label "clause" i+1-string))
          (default-label (string-append label "default")))
     (define (jump label)
-      (wrap-as (i386:jump label)))
+      (wrap-as (as info 'jump label)))
     (pmatch o
       ((case ,test)
        (define (jump-nz label)
-         (wrap-as (i386:jump-nz label)))
+         (wrap-as (as info 'jump-nz label)))
        (define (jump-z label)
-         (wrap-as (i386:jump-z label)))
+         (wrap-as (as info 'jump-z label)))
        (define (test->text test)
          (let ((value (pmatch test
                         (0 0)
                         ((p-expr (fixed ,value)) (cstring->int value))
                         ((neg (p-expr (fixed ,value))) (- (cstring->int value)))
                         (_ (error "case test: not supported: " test)))))
-           (append (wrap-as (i386:accu-cmp-value value))
+           (append (wrap-as (as info 'r-cmp-value value))
                    (jump-z body-label))))
        (let ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
                        info)))
                         info))
               (info (switch->info #f label count `(case ,test) i info))
               (info (append-text info (jump next-clause-label)))
-              (info (append-text info (wrap-as `((#:label ,body-label))))))
-         (ast->info statement info)))
+              (info (append-text info (wrap-as `((#:label ,body-label)))))
+              (info (ast->info statement info))
+              ;; 66-local-char-array -- fallthrough FIXME
+              ;; (info (if last? info
+              ;;           (append-text info (jump next-body-label))))
+              )
+         info))
       ((case ,test (case . ,case1) . ,rest)
        (let ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
                        info)))
       ((default (case . ,case1) . ,rest)
        (let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
                         info))
-               (info (if last? info
+              (info (if last? info
                          (append-text info (jump next-clause-label))))
               (info (append-text info (wrap-as `((#:label ,default-label)))))
-              (info (append-text info (jump body-label))))
+              (info (append-text info (jump body-label)))
+              (info (append-text info (wrap-as `((#:label ,body-label))))))
          (fold (cut switch->info #f label count <> i <>) info `((case ,@case1) ,@rest))))
       (default
         (let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
                          info))
                (info (if last? info
                          (append-text info (jump next-clause-label))))
-               (info (append-text info (wrap-as `((#:label ,default-label))))))
-          (append-text info (jump body-label))))
+               (info (append-text info (wrap-as `((#:label ,default-label)))))
+               (info (append-text info (jump body-label)))
+               (info (append-text info (wrap-as `((#:label ,body-label))))))
+          info))
       ((default ,statement)
        (let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
                         info))
               (info (if last? info
                         (append-text info (jump next-clause-label))))
-              (info (append-text info (wrap-as `((#:label ,body-label)))))
-              (info (append-text info (wrap-as `((#:label ,default-label))))))
+              (info (append-text info (wrap-as `((#:label ,default-label)))))
+              (info (append-text info (wrap-as `((#:label ,body-label))))))
          (ast->info statement info)))
       ((default ,statement ,rest)
        (let* ((info (if clause? (append-text info (wrap-as `((#:label ,clause-label))))
                         info))
               (info (if last? info
                         (append-text info (jump next-clause-label))))
-              (info (append-text info (wrap-as `((#:label ,body-label)))))
-              (info (append-text info (wrap-as `((#:label ,default-label))))))
+              (info (append-text info (wrap-as `((#:label ,default-label)))))
+              (info (append-text info (wrap-as `((#:label ,body-label))))))
          (fold ast->info (ast->info statement info) rest)))
       ((labeled-stmt (ident ,goto-label) ,statement)
        (let ((info (append-text info `(((#:label ,(string-append "_" (.function info) "_label_" goto-label)))))))
     ((array-of (ident ,name) ,count) (expr->number info count))
     (_ #f)))
 
-(define (init->accu o info)
+(define (init->r o info)
   (pmatch o
-    ((initzer-list (initzer ,expr)) (expr->register expr info))
+    ((initzer-list (initzer ,expr))
+     (expr->register expr info))
     (((#:string ,string))
-     (append-text info (list (i386:label->accu `(#:string ,string)))))
+     (expr->register `(p-expr (string ,string)) info))
     ((,number . _) (guard (number? number))
-     (append-text info (wrap-as (i386:value->accu 0))))
-    ((,c . ,_) (guard (char? c)) info)
-    (_ (expr->register o info))))
+     (expr->register `(p-expr (fixed 0)) info))
+    ((,c . ,_) (guard (char? c))
+     info)
+    (_
+     (expr->register o info))))
 
-(define (init-struct-field local field init info)
+(define (init-struct-field local field init info)
   (let* ((offset (field-offset info (local:type local) (car field)))
-         (size (field:size field))
-         (empty (clone info #:text '())))
-    (clone info #:text
-           (append
-            (.text info)
-            (local->accu local)
-            (wrap-as (append (i386:accu->base)))
-            (wrap-as (append (i386:push-base)))
-            (.text (expr->register init empty))
-            (wrap-as (append (i386:pop-base)))
-            (wrap-as (case size
-                       ((1) (i386:byte-accu->base-mem+n offset))
-                       ((2) (i386:word-accu->base-mem+n offset))
-                       (else (i386:accu->base-mem+n offset))))))))
+         (size (field:size field info))
+         (offset (+ offset (* n size)))
+         (info (expr->register init info))
+         (info (allocate-register info))
+         (info (append-text info (local->r local info)))
+         (info (append-text info (wrap-as (as info 'r+value offset))))
+         (reg-size (->size "*" info))
+         (size (min size reg-size))
+         (info (r0->r1-mem*n info size size))
+         (info (free-register info))
+         (info (free-register info)))
+    info))
+
+(define (init-struct-struct-field local type offset field init info)
+  (let* ((offset (+ offset (field-offset info type (car field))))
+         (size (field:size field info))
+         (info (expr->register init info))
+         (info (allocate-register info))
+         (info (append-text info (local->r local info)))
+         (info (append-text info (wrap-as (as info 'r+value offset))))
+         (reg-size (->size "*" info))
+         (size (min size reg-size))
+         (info (r0->r1-mem*n info size size))
+         (info (free-register info))
+         (info (free-register info)))
+    info))
 
 (define (init-array-entry local index init info)
   (let* ((type (local:type local))
-         (size (cond ((pointer? type) %pointer-size)
-                     ((and (c-array? type) ((compose pointer? c-array:type) type)) %pointer-size)
+         (size (cond ((pointer? type) (->size "*" info))
+                     ((and (c-array? type) ((compose pointer? c-array:type) type)) (->size "*" info))
                      ((c-array? type) ((compose type:size c-array:type) type))
                      (else (type:size type))))
          (offset (* index size))
-         (empty (clone info #:text '())))
-    (clone info #:text
-           (append
-            (.text info)
-            (local->accu local)
-            (wrap-as (append (i386:accu->base)))
-            (wrap-as (append (i386:push-base)))
-            (.text (expr->register init empty))
-            (wrap-as (append (i386:pop-base)))
-            (wrap-as (case size
-                       ((1) (i386:byte-accu->base-mem+n offset))
-                       ((2) (i386:word-accu->base-mem+n offset))
-                       (else (i386:accu->base-mem+n offset))))))))
-
+         (info (expr->register init info))
+         (info (allocate-register info))
+         (info (append-text info (local->r local info)))
+         (info (append-text info (wrap-as (as info 'r+value offset))))
+         (reg-size (->size "*" info))
+         (size (min size reg-size))
+         (info (r0->r1-mem*n info size size))
+         (info (fold (lambda (x info) (free-register info)) info (.allocated info))))
+    info))
 
 (define (init-local local o n info)
   (pmatch o
     (#f info)
     ((initzer ,init)
      (init-local local init n info))
-    ((initzer-list ,init)
-     (init-local local init n info))
     ((initzer-list . ,inits)
-     (let ((struct? (structured-type? local)))
-       (cond (struct?
-              (let ((fields ((compose struct->init-fields local:type) local)))
-                (fold (cut init-struct-field local <> <> <>) info fields (append inits (map (const '(p-expr (fixed "22"))) (iota (max 0 (- (length fields) (length inits)))))))))
-             (else (fold (cut init-local local <> <> <>) info inits (iota (length inits)))))))
+     (let ((local-type (local:type local)))
+       (cond ((structured-type? local)
+              (let* ((fields (struct->init-fields local-type))
+                     (field+counts (let loop ((fields fields))
+                                     (if (null? fields) '()
+                                         (let* ((field (car fields))
+                                                (type (cdr field)))
+                                           (cond ((c-array? type)
+                                                  (append (map
+                                                           (lambda (i)
+                                                             (let ((field (cons (car field) (c-array:type type))))
+                                                               (cons field i)))
+                                                           (iota (c-array:count type)))
+                                                          (loop (cdr fields))))
+                                                 (else
+                                                  (cons (cons field 0) (loop (cdr fields))))))))))
+                (let loop ((field+counts field+counts) (inits inits) (info info))
+                  (if (null? field+counts) info
+                      (let* ((field (caaar field+counts))
+                             (type (cdaar field+counts)))
+                        (if (and (type? type)
+                                 (eq? (type:type type) 'struct))
+                            (let* ((field-fields (type:description type))
+                                   (field-inits (list-head inits (max (length inits) (length field-fields))))
+                                   (missing (max 0 (- (length field-fields) (length field-inits))))
+                                   (field-inits+ (append field-inits (map (const '(p-expr (fixed "0"))) (iota missing))))
+                                   (offset (field-offset info local-type field))
+                                   ;; (info (init-local local `(initzer-list ,field-inits) n info))
+                                   ;; crap, howto recurse? -- would need new local for TYPE
+                                   ;; just do two deep for now
+                                   (info (fold (cut init-struct-struct-field local type offset <> <> <>) info field-fields field-inits+)))
+                              (loop (list-tail field+counts (min (length field+counts) (length field-fields)))
+                                    (list-tail inits (min (length field-inits) (length field-inits))) info))
+                            (let* ((missing (max 0 (- (length field+counts) (length inits))))
+                                   (counts (map cdr field+counts))
+                                   (fields (map car field+counts))
+                                   (info (fold (cut init-struct-field local <> <> <> <>) info fields counts (append inits (map (const '(p-expr (fixed "22"))) (iota missing))))))
+                              ;; bah, loopme!
+                              ;;(loop (list-tail field+counts (length field-fields)) (list-tail inits (length field-inits)) info)
+                              info)))))))
+             (else
+              (let* ((type (local:type local))
+                     (type (if (c-array? type) (c-array:type type) type))
+                     (size (->size type info)))
+                (fold (cut init-local local <> <> <>) info inits (iota (length inits) 0 size)))))))
     (,string (guard (string? string))
              (let ((inits (string->list string)))
                (fold (cut init-array-entry local <> <> <>) info (iota (length inits)) inits)))
+
     (((initzer (initzer-list . ,inits)))
-     (fold (cut init-array-entry local <> <> <>) info (iota (length inits)) inits))
+     (init-local local (car o) n info))
+
     (() info)
-    (_ (let ((info (init->accu o info)))
-         (append-text info (accu->local+n-text local n))))))
+    (_ (let* ((info (init->r o info))
+              (info (append-text info (r->local+n-text info local n))))
+         (free-register info)))))
 
 (define (local->info type name o init info)
   (let* ((locals (.locals info))
                           (c-array? (pointer:type (pointer:type type)))
                           (pointer:type (pointer:type type)))))
          (struct? (structured-type? type))
-         (size (->size type))
+         (size (->size type info))
          (string (and array? (array-init->string init)))
          (init (or string init))
+         (reg-size (->size "*" info))
          (local (if (not array?) local
                     (let ((size (or (and string (max size (1+ (string-length string))))
                                     size)))
-                      (make-local-entry name type (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))))
-         (local (if struct? (make-local-entry name type (+ (local:id (cdr local)) (quotient (+ size 3) 4)))
+                      (make-local-entry name type (+ (local:id (cdr local)) -1 (quotient (+ size (1- reg-size)) reg-size))))))
+         (local (if struct? (make-local-entry name type (+ (local:id (cdr local)) (quotient (+ size (1- reg-size)) reg-size)))
                     local))
          (locals (cons local locals))
          (info (clone info #:locals locals))
 
 (define (global->info type name o init info)
   (let* ((rank (->rank type))
-         (size (->size type))
+         (size (->size type info))
          (data (cond ((not init) (string->list (make-string size #\nul)))
                      ((c-array? type)
                       (let* ((string (array-init->string init))
 (define (array-init-element->data type o info)
   (pmatch o
     ((initzer (p-expr (string ,string)))
-     `((#:string ,string)))
+     (let ((reg-size (->size "*" info)))
+       (if (= reg-size 8) `((#:string ,string) "%0")
+           `((#:string ,string)))))
     ((initzer (p-expr (fixed ,fixed)))
-     (int->bv type (expr->number info fixed)))
+     (if (structured-type? type)
+         (let ((fields (map cdr (struct->init-fields type))))
+           (int->bv type (expr->number info fixed) info))
+         (int->bv type (expr->number info fixed) info)))
     ((initzer (initzer-list . ,inits))
-      (if (structured-type? type)
-          (let* ((fields (map cdr (struct->init-fields type)))
-                 (missing (max 0 (- (length fields) (length inits))))
-                 (inits (append inits
-                                (map (const '(fixed "0")) (iota missing)))))
-            (map (cut init->data <> <> info) fields inits))
-          (begin
-            (stderr "array-init-element->data: oops:~s\n" o)
-            (stderr "type:~s\n" type)
-            (error "array-init-element->data: not supported: " o))))
+     (if (structured-type? type)
+         (let* ((fields (map cdr (struct->init-fields type)))
+                (missing (max 0 (- (length fields) (length inits))))
+                (inits (append inits
+                               (map (const '(fixed "0")) (iota missing)))))
+           (map (cut init->data <> <> info) fields inits))
+         (begin
+           (stderr "array-init-element->data: oops:~s\n" o)
+           (stderr "type:~s\n" type)
+           (error "array-init-element->data: unstructured not supported: " o))))
     (_ (init->data type o info))
     (_ (error "array-init-element->data: not supported: " o))))
 
   (pmatch o
     ((initzer (initzer-list . ,inits))
      (let ((type (c-array:type type)))
-       (map (cut array-init-element->data type <> info) inits)))
+       (if (structured-type? type)
+           (let* ((fields (length (struct->init-fields type))))
+             (let loop ((inits inits))
+               (if (null? inits) '()
+                   (let ((init (car inits)))
+                     (pmatch init
+                       ((initzer (initzer-list . ,car-inits))
+                        (append (array-init-element->data type init info)
+                                (loop (cdr inits))))
+                       (_ (let* ((count (min (length inits) fields))
+                                 (field-inits (list-head inits count)))
+                            (append (array-init-element->data type `(initzer-list ,@field-inits) info)
+                                    (loop (list-tail inits count))))))))))
+           (map (cut array-init-element->data type <> info) inits))))
 
     (((initzer (initzer-list . ,inits)))
      (array-init->data type size (car o) info))
      (array-init->data type size (car o) info))
 
     ((initzer (p-expr (fixed ,fixed)))
-     (int->bv type (expr->number info fixed)))
+     (int->bv type (expr->number info fixed) info))
 
     (() (string->list (make-string size #\nul)))
     (_ (error "array-init->data: not supported: " o))))
 (define (init->data type o info)
   (pmatch o
     ((p-expr ,expr) (init->data type expr info))
-    ((fixed ,fixed) (int->bv type (expr->number info o)))
-    ((char ,char) (int->bv type (char->integer (string-ref char 0))))
-    ((string ,string) `((#:string ,string)))
-    ((string . ,strings) `((#:string ,(string-join strings ""))))
+    ((fixed ,fixed) (int->bv type (expr->number info o) info))
+    ((char ,char) (int->bv type (char->integer (string-ref char 0)) info))
+    ((string ,string)
+     (let ((reg-size (->size "*" info)))
+       (if (= reg-size 8) `((#:string ,string) "%0")
+           `((#:string ,string)))))
+    ((string . ,strings)
+     (let ((reg-size (->size "*" info)))
+       (if (= reg-size 8) `((#:string ,(string-join strings "")) "%0")
+           `((#:string ,(string-join strings ""))))))
     ((ident ,name) (let ((var (ident->variable info name)))
                      `((#:address ,var))))
     ((initzer-list . ,inits)
      (cond ((structured-type? type)
             (map (cut init->data <> <> info) (map cdr (struct->init-fields type)) inits))
            ((c-array? type)
-            (let ((size (->size type)))
-             (array-init->data type size `(initzer ,o) info)))
+            (let ((size (->size type info)))
+              (array-init->data type size `(initzer ,o) info)))
            (else
             (append-map (cut init->data type <> info) inits))))
     (((initzer (initzer-list . ,inits)))
      (init->data type `(initzer-list . ,inits) info))
     ((ref-to (p-expr (ident ,name)))
-     (let ((var (ident->variable info name)))
-       `((#:address ,var))))
+     (let ((var (ident->variable info name))
+           (reg-size (->size "*" info)))
+       `((#:address ,var)
+         ,@(if (= reg-size 8) '((#:address 0))
+               '()))))
     ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
      (let* ((type (ast->type struct info))
             (offset (field-offset info type field))
             (base (cstring->int base)))
-       (int->bv type (+ base offset))))
+       (int->bv type (+ base offset) info)))
     ((,char . _) (guard (char? char)) o)
     ((,number . _) (guard (number? number))
-     (append (map int->bv type o)))
+     (append (map (cut int->bv <> <> info) type o)))
     ((initzer ,init) (init->data type init info))
     (((initzer ,init)) (init->data type init info))
     ((cast _ ,expr) (init->data type expr info))
     (() '())
     (_ (let ((number (try-expr->number info o)))
-         (cond (number (int->bv type number))
+         (cond (number (int->bv type number info))
                (else (error "init->data: not supported: " o)))))))
 
-(define (int->bv type o)
-  (let ((size (->size type)))
+(define (int->bv type o info)
+  (let ((size (->size type info)))
     (case size
-      ;;((1) (int->bv8 o))
-      ;;((2) (int->bv16 o))
-      (else (int->bv32 o)))))
+      ((1) (int->bv8 o))
+      ((2) (int->bv16 o))
+      ((4) (int->bv32 o))
+      ((8) (int->bv64 o))
+      (else (int->bv64 o)))))
 
 (define (init->strings o info)
   (let ((globals (.globals info)))
     ((struct-def (field-list . ,fields))
      (mescc:trace name " <t>")
      (let* ((info (fold field->info info fields))
-            (type-entry (struct->type-entry name (append-map (struct-field info) fields))))
+            (type-entry (struct->type-entry info name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
 
     ((struct-def (ident ,name) (field-list . ,fields))
      (mescc:trace name " <t>")
      (let* ((info (fold field->info info fields))
-            (type-entry (struct->type-entry name (append-map (struct-field info) fields))))
+            (type-entry (struct->type-entry info name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
 
     ((union-def (ident ,name) (field-list . ,fields))
      (mescc:trace name " <t>")
-     (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
+     (let ((type-entry (union->type-entry info name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
 
     ((union-def (field-list . ,fields))
      (mescc:trace name " <t>")
-     (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
+     (let ((type-entry (union->type-entry info name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
 
     ((enum-ref . _) info)
     ((void) info)
 
     (_ ;;(error "type->info: not supported:" o)
-     (stderr "type->info: not supported: ~s\n" o)
      info
      )))
 
   (pmatch o
     ((comp-decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))) . _)
      (let* ((fields (append-map (struct-field info) fields))
-            (struct (make-type 'struct (apply + (map field:size fields)) fields)))
+            (struct (make-type 'struct (apply + (map (cut field:size <> info) fields)) fields)))
        (clone info #:types (acons `(tag ,name) struct (.types info)))))
     ((comp-decl (decl-spec-list (type-spec (union-def (ident ,name) (field-list . ,fields)))) . _)
      (let* ((fields (append-map (struct-field info) fields))
-            (union (make-type 'union (apply + (map field:size fields)) fields)))
+            (union (make-type 'union (apply + (map (cut field:size <> info) fields)) fields)))
        (clone info #:types (acons `(tag ,name) union (.types info))) ))
     ((comp-decl (decl-spec-list (type-spec (enum-def (enum-def-list . ,fields)))) . _)
      (let ((constants (enum-def-list->constants (.constants info) fields)))
             (rank (ptr-declr->rank pointer)))
        (if (zero? rank) type
            (make-pointer type rank))))
+    (((decl-spec-list (stor-spec ,store) (type-spec ,type)) (ptr-declr ,pointer . _) ,statement)
+     (let* ((type (ast->type type info))
+            (rank (ptr-declr->rank pointer)))
+       (if (zero? rank) type
+           (make-pointer type rank))))
     (((decl-spec-list (type-spec ,type)) . _)
      (ast->type type info))
     (((decl-spec-list (stor-spec ,store) (type-spec ,type)) . _)
      (ast->type type info))
-
-    ;; (((decl-spec-list (stor-spec ,store) (type-spec ,type)) (ftn-declr (ident _) _) _)
-    ;;  (ast->type type info))
-    ;; (((decl-spec-list (stor-spec ,store) (type-spec ,type)) (ptr-declr ,pointer (ftn-declr (ident _) _)) _)
-    ;;  (ast->type type info))
-
     (_ (error "fctn-defn:get-type: not supported:" o))))
 
 (define (ftn-declr:get-type info o)
            (locals (.locals info))
            (local (and (pair? locals) (car locals)))
            (count (and=> local (compose local:id cdr)))
-           (stack (and count (* count 4))))
+           (reg-size (->size "*" info))
+           (stack (and count (* count reg-size))))
       (if (and stack (getenv "MESC_DEBUG")) (stderr "        stack: ~a\n" stack))
       (clone info
              #:function #f
index d617a0e847d041fbe844c93187170a32a208f8fc..836789d3b69e79126718cf28e891710653f2717a 100644 (file)
   #:use-module (mescc as)
   #:use-module (mescc info)
   #:export (
-            i386:accu%base
-            i386:accu*base
-            i386:accu*n->label
-            i386:accu*n->local
-            i386:accu+accu
-            i386:accu+base
-            i386:accu+value
-            i386:accu->base
-            i386:accu->base-mem
-            i386:byte-accu->base-mem
-            i386:word-accu->base-mem
-            i386:accu->base-mem+n
-            i386:byte-accu->base-mem+n
-            i386:word-accu->base-mem+n
-            i386:accu->label
-            i386:accu->local
-            i386:accu->local+n
-            i386:accu->local+n
-            i386:accu-and
-            i386:accu-and-base
-            i386:accu-and-base-mem
-            i386:accu-base
-            i386:accu-cmp-value
-            i386:accu-mem-add
-            i386:accu-mem->base-mem
-            i386:accu-negate
-            i386:accu-not
-            i386:accu-or-base
-            i386:accu-or-base-mem
-            i386:accu-shl
-            i386:accu-test
-            i386:accu-xor-base
-            i386:accu-zero?
-            i386:accu/base
-            i386:accu<->stack
-            i386:accu<<base
-            i386:accu>>base
-            i386:base+value
-            i386:base->accu
-            i386:base->accu-mem
-            i386:base->label
-            i386:base-mem->accu-mem
-            i386:base-mem+n->accu
-            i386:base-mem->accu
-            i386:base-sub
-            i386:byte-accu->base-mem
-            i386:word-accu->base-mem
-            i386:byte-base->accu-mem
-            i386:byte-base->accu-mem+n
-            i386:byte-base-mem->accu
-            i386:byte-base-sub
-            i386:byte-local->base
-            i386:byte-mem->accu
-            i386:word-mem->accu
-            i386:byte-mem->base
-            i386:byte-sub-base
-            i386:byte-test-base
-            i386:call-accu
-            i386:call-label
-            i386:formal
-            i386:jump
-            i386:jump
-            i386:jump-a
-            i386:jump-ae
-            i386:jump-b
-            i386:jump-be
-            i386:jump-byte-z
-            i386:jump-g
-            i386:jump-ge
-            i386:jump-l
-            i386:jump-le
-            i386:jump-nz
-            i386:jump-z
-            i386:label->accu
-            i386:label->base
-            i386:label-mem->accu
-            i386:label-mem->base
-            i386:label-mem-add
-            i386:local->accu
-            i386:local->base
-            i386:local-add
-            i386:local-address->accu
-            i386:local-address->accu
-            i386:local-address->base
-            i386:local-ptr->accu
-            i386:local-ptr->base
-            i386:local-test
-            i386:mem+n->accu
-            i386:byte-mem+n->accu
-            i386:word-mem+n->accu
-            i386:mem->accu
-            i386:mem->base
-            i386:nop
-            i386:nz->accu
-            i386:pop-accu
-            i386:pop-base
-            i386:push-accu
-            i386:push-base
-            i386:push-byte-local-de-de-ref
-            i386:push-byte-local-de-ref
-            i386:push-word-local-de-ref
-            i386:push-label
-            i386:push-label-mem
-            i386:push-local
-            i386:push-local-address
-            i386:push-local-de-ref
-            i386:ret-local
-            i386:sub-base
-            i386:test-base
-            i386:value->accu
-            i386:value->accu-mem
-            i386:value->accu-mem+n
-            i386:value->base
-            i386:value->label
-            i386:value->local
-            i386:xor-accu
-            i386:xor-zf
-            i386:g?->accu
-            i386:ge?->accu
-            i386:l?->accu
-            i386:le?->accu
-            i386:a?->accu
-            i386:ae?->accu
-            i386:b?->accu
-            i386:be?->accu
-            i386:z->accu
-            i386:byte-accu
-            i386:signed-byte-accu
-            i386:word-accu
-            i386:signed-word-accu
-
             i386:instructions
             ))
 
-(define (i386:nop)
-  '(("nop")))
+(define (e->x o)
+  (string-drop o 1))
+
+(define (e->l o)
+  (string-append (string-drop-right (string-drop o 1) 1) "l"))
+
 
 (define (i386:function-preamble . rest)
   '(("push___%ebp")
 (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-label-mem label)
-  `(("mov____0x32,%eax" (#:address ,label)) ; mov    0x804a000,%eax
-    ("push___%eax")))                       ; push  %eax
-
-
-;;; \f locals
-
-(define (i386:push-local n)
-  (or n (error "invalid value: push-local: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("push___0x8(%ebp)" (#:immediate1 ,n))
-           `("push___0x32(%ebp)" (#:immediate ,n))))))
-
-(define (i386:push-local-address n)
-  (or n (error "invalid value: push-local-address: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("lea____0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("lea____0x32(%ebp),%eax" (#:immediate ,n)))
-      ("push___%eax"))))
-
-(define (i386:push-byte-local-de-ref n)
-  (or n (error "invalid value: push-byte-local-de-ref: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("mov____0x32(%ebp),%eax" (#:immediate ,n)))
-      ("movzbl_(%eax),%eax")
-      ("push___%eax"))))
-
-(define (i386:push-word-local-de-ref n)
-  (or n (error "invalid value: push-word-local-de-ref: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("mov____0x32(%ebp),%eax" (#:immediate ,n)))
-      ("movzwl_(%eax),%eax")
-      ("push___%eax"))))
-
-(define (i386:push-byte-local-de-de-ref n)
-  (or n (error "invalid value: push-byte-local-de-de-ref: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("mov____0x32(%ebp),%eax" (#:immediate ,n)))
-      ("mov____(%eax),%eax")
-      ("movzbl_(%eax),%eax")
-      ("push___%eax"))))
-
-(define (i386:push-local-de-ref n)
-  (or n (error "invalid value: push-byte-local-de-ref: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("mov____0x32(%ebp),%eax" (#:immediate ,n)))
-      ("mov____(%eax),%eax")
-      ("push___%eax"))))
-
-(define (i386:local-add n v)
-  (or n (error "invalid value: i386:local-add: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (and (< (abs n) #x80)
-                (< (abs v) #x80)) `("add____$i8,0x8(%ebp)" (#:immediate1 ,n) (#:immediate1 ,v))
-                `("add____$i32,0x32(%ebp)" (#:immediate ,n) (#:immediate ,v))))))
-
-(define (i386:accu->local n)
-  (or n (error "invalid value: accu->local: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____%eax,0x8(%ebp)" (#:immediate1 ,n))
-           `("mov____%eax,0x32(%ebp)" (#:immediate ,n))))))
-
-(define (i386:accu->local+n id n)
-  (let ((n (+ (- 0 (* 4 id)) n)))
-    `(,(if (< (abs n) #x80) `("mov____%eax,0x8(%ebp)" (#:immediate1 ,n))
-           `("mov____%eax,0x32(%ebp)" (#:immediate ,n))))))
-
-(define (i386:accu*n->local i n)
-  (or n (error "invalid value: accu->local: " n))
-  (let ((o (- 0 (* 4 i))))
-    (let loop ((i 0))
-      (if (>= i n) '()  ;; FIXME: byte, word-sized
-          (let ((o (+ o i)))
-            (append
-             (if (< (abs o) #x80) `(("mov____0x8(%eax),%ebx" (#:immediate1 ,i))
-                                    ("mov____%ebx,0x8(%ebp)" (#:immediate1 ,o)))
-                 `(("mov____0x8(%eax),%ebx" (#:immediate1 ,i))
-                   ("mov____%ebx,0x32(%ebp)" (#:immediate ,o))))
-             (loop (+ i 4))))))))
-
-(define (i386:local->accu n)
-  (or n (error "invalid value: local->accu: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("mov____0x32(%ebp),%eax" (#:immediate ,n))))))
-
-(define (i386:local-address->accu n)
-  (or n (error "invalid value: ladd: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("lea____0x8(%ebp),%eax" (#:immediate1 ,n))
-           `("lea____0x32(%ebp),%eax" (#:immediate ,n))))))
-
-(define (i386:local-ptr->accu n)
-  (or n (error "invalid value: local-ptr->accu: " n))
-  (let ((n (- 0 (* 4 n))))
-  `(("mov____%ebp,%eax")                ; mov    %ebp,%eax
-    ,(if (< (abs n) #x80) `("add____$i8,%eax" (#:immediate1 ,n))
-         `("add____$i32,%eax" (#:immediate ,n))))))
-
-(define (i386:byte-local->base n)
-  (or n (error "invalid value: byte-local->base: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("movzbl_0x8(%ebp),%edx" (#:immediate1 ,n))
-           `,@(("mov_0x32(%ebp),%edx" (#:immediate ,n))
-               ("movzbl_%dl,%edx"))))))
-
-(define (i386:local->base n)
-  (or n (error "invalid value: local->base: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____0x8(%ebp),%edx" (#:immediate1 ,n))
-           `("mov____0x32(%ebp),%edx" (#:immediate ,n))))))
-
-(define (i386:local-address->base n) ;; DE-REF
-  (or n (error "invalid value: local-address->base: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("lea____0x8(%ebp),%edx" (#:immediate1 ,n))
-           `("lea____0x32(%ebp),%edx" (#:immediate ,n))))))
-
-(define (i386:local-ptr->base n)
-  (or n (error "invalid value: local-ptr->base: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(("mov____%ebp,%edx")                ; mov    %ebp,%edx
-      ,(if (< (abs n) #x80) `("add____$i8,%edx" (#:immediate1 ,n))
-           `("add____$i32,%edx" (#:immediate ,n))))))
-
-(define (i386:value->local n v)
-  (or n (error "invalid value: value->local: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(if (< (abs n) #x80) `("mov____$i32,0x8(%ebp)" (#:immediate1 ,n) (#:immediate ,v))
-           `("mov____$i32,0x32(%ebp)" (#:immediate ,n) (#:immediate ,v))))))
-
-(define (i386:local-test n v)
-  (or n (error "invalid value: local-test: " n))
-  (let ((n (- 0 (* 4 n))))
-    `(,(cond ((and (< (abs n) #x80)
-                   (< (abs v) #x80)) `("cmp____$i8,0x8(%ebp)" (#:immediate1 ,n) (#:immediate1 ,v)))
-             ((< (abs n) #x80) `("cmp____$i32,0x8(%ebp)" (#:immediate1 ,n) (#:immediate ,v)))
-             ((< (abs v) #x80) `("cmp____$i8,0x32(%ebp)" (#:immediate ,n) (#:immediate1 ,v)))
-             (else `("cmp____$i32,0x32(%ebp)" (#:immediate ,n) (#:immediate ,v)))))))
-
-(define (i386:pop-accu)
-  '(("pop____%eax")))                   ; pop %eax
-
-(define (i386:push-accu)
-  '(("push___%eax")))                   ; push %eax
-
-(define (i386:pop-base)
-  '(("pop____%edx")))                   ; pop %edx
+(define (i386:r->local info n)
+  (or n (error "invalid value: i386:r->local: " n))
+  (let ((r (get-r info))
+        (n (- 0 (* 4 n))))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____%" r ",0x8(%ebp)") (#:immediate1 ,n))
+           `(,(string-append "mov____%" r ",0x32(%ebp)") (#:immediate ,n))))))
 
-(define (i386:push-base)
-  '(("push___%edx")))                   ; push %edx
+(define (i386:value->r info v)
+  (let ((r (get-r info)))
+    `((,(string-append "mov____$i32,%" r) (#:immediate ,v)))))
 
 (define (i386:ret . rest)
   '(("leave")
     ("ret")))
 
-(define (i386:accu->base)
-  '(("mov____%eax,%edx")))              ; mov    %eax,%edx
-
-(define (i386:accu->base-mem)
-  '(("mov____%eax,(%edx)")))            ; mov    %eax,(%edx)
-
-(define (i386:byte-accu->base-mem)
-  '(("mov____%al,(%edx)")))             ; mov    %al,(%edx)
-
-(define (i386:word-accu->base-mem)
-  '(("mov____%ax,(%edx)")))             ; mov    %ax,(%edx)
-
-(define (i386:accu->base-mem+n n)
-  (or n (error "invalid value: accu->base-mem+n: " n))
-  `(,(if (< (abs n) #x80) `("mov____%eax,0x8(%edx)" (#:immediate1 ,n))
-         `("mov____%eax,0x32(%edx)" (#:immediate ,n)))))
-
-(define (i386:byte-accu->base-mem+n n)
-  (or n (error "invalid value: accu->base-mem+n: " n))
-  `(,(if (< (abs n) #x80) `("mov____%al,0x8(%edx)" (#:immediate1 ,n))
-         `("mov____%al,0x32(%edx)" (#:immediate ,n)))))
-
-(define (i386:word-accu->base-mem+n n)
-  (or n (error "invalid value: accu->base-mem+n: " n))
-  `(,(if (< (abs n) #x80) `("mov____%ax,0x8(%edx)" (#:immediate1 ,n))
-         `("mov____%ax,0x32(%edx)" (#:immediate ,n)))))
-
-(define (i386:accu->label label)
-  `(("mov____%eax,0x32" (#:address ,label)))) ; mov    %eax,0x<label>
-
-(define (i386:accu*n->label label n)
-  (append
-   '(("push___%edx"))
-   (let loop ((i 0))
-     (if (>= i n) '() ;; FIXME: byte, word-sized
-         (append
-          `(("mov____$i32,%edx" (#:address ,label))
-            ("mov____0x8(%eax),%ebx" (#:immediate1 ,i))
-            ("mov____%ebx,0x8(%edx)" (#:immediate1 ,i)))
-          (loop (+ i 4)))))
-   '(("pop____%edx"))))
-
-(define (i386:accu-shl n)
-  (or n (error "invalid value: accu:shl n: " n))
-  `(("shl____$i8,%eax" (#:immediate1 ,n)))) ; shl    $0x8,%eax
-
-(define (i386:accu<<base)
-  '(("xor____%ecx,%ecx")                ; xor    %ecx,%ecx
-    ("mov____%edx,%ecx")                ; mov    %edx,%ecx
-    ("shl____%cl,%eax")))               ; shl    %cl,%eax
-
-(define (i386:accu>>base)
-  '(("xor____%ecx,%ecx")                ; xor    %ecx,%ecx
-    ("mov____%edx,%ecx")                ; mov    %edx,%ecx
-    ("shr____%cl,%eax")))               ; shr    %cl,%eax
-
-(define (i386:accu-and-base)
-  '(("and____%edx,%eax")))
-
-(define (i386:accu-and v)
-  `(("and____$i32,%eax" (#:immediate ,v))))
-
-(define (i386:accu-and-base-mem)
-  '(("and____(%edx),%eax")))
-
-(define (i386:accu-or-base-mem)
-  '(("or_____(%edx),%eax")))
-
-(define (i386:accu-not)
-  '(("not____%eax")))                   ; not %eax
-
-(define (i386:accu-or-base)
-  '(("or_____%edx,%eax")))              ; or    %edx,%eax
-
-(define (i386:accu-xor-base)
-  '(("xor____%edx,%eax")))              ; xor    %edx,%eax
-
-(define (i386:accu+accu)
-  '(("add____%eax,%eax")))              ; add    %eax,%eax
-
-(define (i386:accu+base)
-  `(("add____%edx,%eax")))              ; add    %edx,%eax
-
-(define (i386:accu+value v)
-  `(,(if (< (abs v) #x80) `("add____$i8,%eax" (#:immediate1 ,v))
-         `("add____$i32,%eax" (#:immediate ,v)))))
-
-(define (i386:base+value v)
-  `(,(if (< (abs v) #x80) `("add____$i8,%edx" (#:immediate1 ,v))
-         `("add____$i32,%edx" (#:immediate ,v)))))
-
-(define (i386:accu-base)
-  `(("sub____%edx,%eax")))              ; sub    %edx,%eax
+(define (i386:r-zero? info)
+  (let ((r (get-r info)))
+    `((,(string-append "test___%" r "," "%" r)))))
 
-(define (i386:accu*base)
-  `(("mul____%edx")))                   ; mul    %edx
-
-(define (i386:accu/base)
-  '(("mov____%edx,%ebx")                ; mov    %edx,%ebx
-    ("xor____%edx,%edx")                ; xor    %edx,%edx
-    ("idiv___%ebx")))                   ; div    %ebx
-
-(define (i386:accu%base)
-  '(("mov____%edx,%ebx")                ; mov    %edx,%ebx
-    ("xor____%edx,%edx")                ; xor    %edx,%edx
-    ("idiv___%ebx")                     ; div    %ebx
-    ("mov____%edx,%eax")))              ; mov    %edx,%eax
-
-(define (i386:base->accu)
-  '(("mov____%edx,%eax")))              ; mov    %edx,%eax
-
-(define (i386:label->accu label)
-  `(("mov____$i32,%eax" (#:address ,label)))) ; mov    $<n>,%eax
-
-(define (i386:label->base label)
-  `(("mov____$i32,%edx" (#:address ,label)))) ; mov   $<n>,%edx
-
-(define (i386:label-mem->accu label)
-  `(("mov____0x32,%eax" (#:address ,label)))) ; mov    0x<n>,%eax
-
-(define (i386:label-mem->base label)
-  `(("mov____0x32,%edx" (#:address ,label)))) ; mov    0x<n>,%edx
-
-(define (i386:label-mem-add label v)
-  `(,(if (< (abs v) #x80) `("add____$i8,0x32" (#:address ,label) (#:immediate1 ,v))
-         `("add____$i32,0x32" (#:address ,label) (#:immediate ,v)))))
-
-(define (i386:byte-base-mem->accu)
-  '(("add____%edx,%eax")                ; add    %edx,%eax
-    ("movzbl_(%eax),%eax")))            ; movzbl (%eax),%eax
-
-(define (i386:byte-mem->accu)
-  '(("movzbl_(%eax),%eax")))            ; movzbl (%eax),%eax
-
-(define (i386:word-mem->accu)
-  '(("movzwl_(%eax),%eax")))
-
-(define (i386:byte-mem->base)
-  '(("movzbl_(%edx),%edx")))            ; movzbl (%edx),%edx
-
-(define (i386:base-mem->accu)
-  '(("mov____(%edx),%eax")))
-
-(define (i386:mem->accu)
-  '(("mov____(%eax),%eax")))
-
-(define (i386:mem->base)
-  '(("mov____(%edx),%edx")))
-
-(define (i386:mem+n->accu n)
-  `(,(if (< (abs n) #x80) `("mov____0x8(%eax),%eax" (#:immediate1 ,n))
-         `("mov____0x32(%eax),%eax" (#:immediate ,n)))))
-
-(define (i386:byte-mem+n->accu n)
-  `(,(if (< (abs n) #x80) `("movzbl_0x8(%eax),%eax" (#:immediate1 ,n))
-         `("movzbl_0x32(%eax),%eax" (#:immediate ,n)))))
-
-(define (i386:word-mem+n->accu n)
-  `(,(if (< (abs n) #x80) `("movzwl_0x8(%eax),%eax" (#:immediate1 ,n))
-         `("movzwl_xb0x32(%eax),%eax" (#:immediate ,n)))))
-
-(define (i386:base-mem+n->accu v)
-  (or v (error "invalid value: base-mem+n->accu: " v))
-  `(("add___%edx,%eax")
-    ,(if (< (abs v) #x80) `("mov____0x8(%eax),%eax" (#:immediate1 ,v))
-         `("mov____0x32(%eax),%eax" (#:immediate ,v)))))
-
-(define (i386:value->accu v)
-  (or v (error "invalid value: i386:value->accu: " v))
-  `(("mov____$i32,%eax" (#:immediate ,v))))
-
-(define (i386:value->accu-mem v)
-  `(("mov____$i32,(%eax)" (#:immediate ,v)))) ; movl   $0x<v>,(%eax)
-
-(define (i386:value->accu-mem+n n v)
-  (or v (error "invalid value: i386:value->accu-mem+n: " v))
-  `(,(if (< (abs v) #x80) `("mov____$i32,0x8(%eax)" (#:immediate1 ,n) (#:immediate ,v))
-         `("mov____$i32,0x32(%eax)" (#:immediate ,n) (#:immediate ,v)))))
-
-(define (i386:base->accu-mem)
-  '(("mov____%edx,(%eax)")))            ; mov    %edx,(%eax)
-
-(define (i386:accu-mem->base-mem)
-  '(("mov____(%eax),%ecx")
-    ("mov____%ecx,(%edx)")))
-
-(define (i386:base-mem->accu-mem)
-  '(("mov____(%edx),%ecx")              ; mov    (%edx),%ecx
-    ("mov____%ecx,(%eax)")))            ; mov    %ecx,(%eax)
-
-(define (i386:byte-base->accu-mem)
-  '(("mov____%dl,(%eax)")))             ; mov    %dl,(%eax)
-
-(define (i386:byte-base->accu-mem+n n)
-  (or n (error "invalid value: byte-base->accu-mem+n: " n))
-  `(,(if (< (abs n) #x80) `("mov____%dl,0x8(%eax)" (#:immediate1 ,n))
-         `("mov____%dl,0x32(%eax)" (#:immediate ,n)))))
-
-(define (i386:value->base v)
-  (or v (error "invalid value: i386:value->base: " v))
-  `(("mov____$i32,%edx" (#:immediate ,v)))) ; mov    $<v>,%edx
-
-(define (i386:accu-mem-add v)
-  `(,(if (< (abs v) #x80) `("add____$i8,(%eax)" (#:immediate1 ,v))
-         `("add____$i32,(%eax)" (#:immediate ,v)))))
+(define (i386:local->r info n)
+  (let ((r (get-r info))
+        (n (- 0 (* 4 n))))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____0x8(%ebp),%" r) (#:immediate1 ,n))
+           `(,(string-append "mov____0x32(%ebp),%" r) (#:immediate ,n))))))
 
-(define (i386:value->label label v)
-  (or v (error "invalid value: value->label: " v))
-  `(("mov____$i32,0x32" (#:address ,label)
-     (#:immediate ,v))))
+(define (i386:r0+r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "add____%" r1 ",%" r0)))))
 
 (define (i386:call-label info label n)
   `((call32 (#:offset ,label))
     ("add____$i8,%esp" (#:immediate1 ,(* n 4)))))
 
-(define (i386:call-accu n)
-  `(,@(i386:push-accu)
-    ,@(i386:pop-accu)
-    ("call___*%eax")                    ; call   *%eax
-    ("add____$i8,%esp" (#:immediate1  ,(* n 4))))) ; add    $00,%esp
-
-(define (i386:accu-zero?)
-  '(("test___%eax,%eax")))
-
-(define (i386:accu-negate)
-  '(("sete___%al")                      ; sete %al
-    ("movzbl_%al,%eax")))               ; movzbl %al,%eax
-
-(define (i386:xor-accu v)
-  (or v (error "invalid value: i386:xor-accu: n: " v))
-  `(("xor___$i32,%eax" (#:immediate ,v)))) ;xor    $0xff,%eax
-
-(define (i386:xor-zf)
-  '(("lahf")                               ; lahf
-    ("xor____$i8,%ah" (#:immediate1 #x40)) ; xor    $0x40,%ah
-    ("sahf")))                             ; sahf
-
-(define (i386:accu-cmp-value v)
-  `(,(if (< (abs v) #x80) `("cmp____$i8,%eax" (#:immediate1 ,v))
-         `("cmp____$i32,%eax" (#:immediate ,v)))))
-
-(define (i386:accu-test)
-  '(("test___%eax,%eax")))              ; test   %eax,%eax
-
-(define (i386:jump label)
+(define (i386:r->arg info i)
+  (let ((r (get-r info)))
+    `((,(string-append "push___%" r)))))
+
+(define (i386:label->arg info label i)
+  `(("push___$i32" (#:address ,label))))
+
+(define (i386:r-negate info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "sete___%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:r0-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "sub____%" r1 ",%" r0)))))
+
+(define (i386:zf->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "sete___%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:xor-zf info)
+  '(("lahf")
+    ("xor____$i8,%ah" (#:immediate1 #x40))
+    ("sahf")))
+
+(define (i386:r->local+n info id n)
+  (let ((n (+ (- 0 (* 4 id)) n))
+        (r (get-r info)))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____%" r ",0x8(%ebp)") (#:immediate1 ,n))
+           `(,(string-append "mov____%" r ",0x32(%ebp)") (#:immediate ,n))))))
+
+(define (i386:r-mem-add info v)
+  (let ((r (get-r info)))
+    `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,(%" r ")") (#:immediate1 ,v))
+           `(,(string-append "add____$i32,(%" r ")") (#:immediate ,v))))))
+
+(define (i386:r-byte-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "addb___$i8,(%" r ")") (#:immediate1 ,v)))))
+
+(define (i386:r-word-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "addw___$i8,(%" r ")") (#:immediate2 ,v)))))
+
+(define (i386:local-ptr->r info n)
+  (let ((r (get-r info)))
+    (let ((n (- 0 (* 4 n))))
+      `((,(string-append "mov____%ebp,%" r))
+        ,(if (< (abs n) #x80) `(,(string-append "add____$i8,%" r) (#:immediate1 ,n))
+             `(,(string-append "add____$i32,%" r)  (#:immediate ,n)))))))
+
+(define (i386:label->r info label)
+  (let ((r (get-r info)))
+    `((,(string-append "mov____$i32,%" r) (#:address ,label)))))
+
+(define (i386:r0->r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append  "mov____%" r0 ",%" r1)))))
+
+(define (i386:byte-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "movzbl_(%" r "),%" r)))))
+
+(define (i386:byte-r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:byte-signed-r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "movsbl_%" l ",%" r)))))
+
+(define (i386:word-r info)
+  (let* ((r (get-r info))
+         (x (e->x r)))
+    `((,(string-append "movzwl_%" x ",%" r)))))
+
+(define (i386:word-signed-r info)
+  (let* ((r (get-r info))
+         (x (e->x r)))
+    `((,(string-append "movswl_%" x ",%" r)))))
+
+(define (i386:jump info label)
   `(("jmp32 " (#:offset ,label))))
 
-(define (i386:jump-z label)
-  `(("je32  " (#:offset ,label))))        ; jz . + <n>
+(define (i386:jump-z info label)
+  `(("je32  " (#:offset ,label))))
+
+(define (i386:jump-nz info label)
+  `(("jne32 " (#:offset ,label))))
 
-(define (i386:jump-byte-z label)
-  `(("test___%al,%al")                  ; test   %al,%al
-    ("je32  " (#:offset ,label))))      ; je <n>
+(define (i386:jump-byte-z info label)
+  `(("test___%al,%al")
+    ("je32  " (#:offset ,label))))
 
 ;; signed
-(define (i386:jump-g label)
+(define (i386:jump-g info label)
   `(("jg32  " (#:offset ,label))))
 
-(define (i386:jump-ge label)
+(define (i386:jump-ge info label)
   `(("jge32 " (#:offset ,label))))
 
-(define (i386:jump-l label)
+(define (i386:jump-l info label)
   `(("jl32  " (#:offset ,label))))
 
-(define (i386:jump-le label)
+(define (i386:jump-le info label)
   `(("jle32 " (#:offset ,label))))
 
-(define (i386:g?->accu)
-  '(("setg___%al")
-    ("movzbl_%al,%eax")))
-
-(define (i386:ge?->accu)
-  '(("setge__%al")
-    ("movzbl_%al,%eax")))
-
-(define (i386:l?->accu)
-  '(("setl___%al")
-    ("movzbl_%al,%eax")))
-
-(define (i386:le?->accu)
-  '(("setle__%al")
-    ("movzbl_%al,%eax")))
-
 ;; unsigned
-(define (i386:jump-a label)
+(define (i386:jump-a info label)
   `(("ja32  " (#:offset ,label))))
 
-(define (i386:jump-ae label)
+(define (i386:jump-ae info label)
   `(("jae32 " (#:offset ,label))))
 
-(define (i386:jump-b label)
+(define (i386:jump-b info label)
   `(("jb32  " (#:offset ,label))))
 
-(define (i386:jump-be label)
+(define (i386:jump-be info label)
   `(("jbe32 " (#:offset ,label))))
 
-(define (i386:a?->accu)
-  '(("seta___%al")
-    ("movzbl_%al,%eax")))
-
-(define (i386:ae?->accu)
-  '(("setae__%al")
-    ("movzbl_%al,%eax")))
-
-(define (i386:b?->accu)
-  '(("setb___%al")
-    ("movzbl_%al,%eax")))
-
-(define (i386:be?->accu)
-  '(("setbe__%al")
-    ("movzbl_%al,%eax")))
-
-(define (i386:jump-nz label)
-  `(("jne32 " (#:offset ,label))))       ; jnz . + <n>
-
-(define (i386:byte-test-base)
-  '(("cmp____%al,%dl")))                ; cmp    %al,%dl
-
-(define (i386:test-base)
-  (("cmp____%edx,%eax")))               ; cmp    %edx,%eax
-
-(define (i386:byte-sub-base)
-  '(("sub____%dl,%al")))                ; sub    %dl,%al
-
-(define (i386:byte-base-sub)
-  `(("sub____%al,%dl")))                ; sub    %al,%dl
+(define (i386:byte-r0->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (l0 (e->l r0)))
+    `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
 
-(define (i386:sub-base)
-  `(("sub____%edx,%eax")))              ; sub    %edx,%eax
+(define (i386:label-mem->r info label)
+  (let ((r (get-r info)))
+    `((,(string-append "mov____0x32,%" r) (#:address ,label)))))
 
-(define (i386:base-sub)
-  `(("sub____%eax,%edx")))              ; sub    %eax,%edx
+(define (i386:word-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "movzwl_(%" r "),%" r)))))
 
-(define (i386:nz->accu)
-  '(("setne__%al")                      ; setne   %al
-    ("movzbl_%al,%eax")))               ; movzbl %al,%eax
+(define (i386:mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "mov____(%" r "),%" r)))))
 
-(define (i386:z->accu)
-  '(("sete___%al")                      ; sete   %al
-    ("movzbl_%al,%eax")))               ; movzbl %al,%eax
-
-(define (i386:accu<->stack)
-  '(("xchg___%eax,(%esp)")))            ; xchg   %eax,(%esp)
-
-(define (i386:byte-accu)
-  '(("movzbl_%al,%eax")))
-
-(define (i386:signed-byte-accu)
-  '(("movsbl_%al,%eax")))
+(define (i386:local-add info n v)
+  (let ((n (- 0 (* 4 n))))
+    `(,(if (and (< (abs n) #x80)
+                (< (abs v) #x80)) `("add____$i8,0x8(%ebp)" (#:immediate1 ,n) (#:immediate1 ,v))
+                `("add____$i32,0x32(%ebp)" (#:immediate ,n) (#:immediate ,v))))))
 
-(define (i386:word-accu)
-  '(("movzwl_%ax,%eax")))
+(define (i386:label-mem-add info label v)
+  `(,(if (< (abs v) #x80) `("add____$i8,0x32" (#:address ,label) (#:immediate1 ,v))
+         `("add____$i32,0x32" (#:address ,label) (#:immediate ,v)))))
 
-(define (i386:signed-word-accu)
-  '(("movswl_%ax,%eax")))
+(define (i386:nop info)
+  '(("nop")))
 
+(define (i386:swap-r0-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "xchg___%" r0 ",%" r1)))))
 
+;; signed
+(define (i386:g?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "setg___%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:ge?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "setge__%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:l?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "setl___%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:le?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "setle__%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
 
-;;;;;;;;;;;;
-(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))))))
+;; unsigned
+(define (i386:a?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "seta___%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:ae?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "setae__%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:b?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "setb___%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:be?->r info)
+  (let* ((r (get-r info))
+         (l (e->l r)))
+    `((,(string-append "setbe__%" l))
+      (,(string-append "movzbl_%" l ",%" r)))))
+
+(define (i386:test-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "test___%" r ",%" r)))))
+
+(define (i386:r->label info label)
+  (let ((r (get-r info)))
+    `((,(string-append "mov____%" r ",0x32") (#:address ,label)))))
+
+(define (i386:call-r info n)
+  (let ((r (get-r info)))
+    `((,(string-append "call___*%" r))
+      ("add____$i8,%esp" (#:immediate1  ,(* n 4))))))
+
+(define (i386:r0*r1 info)
+  (let ((allocated (.allocated info))
+        (r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    (if (not (member "edx" allocated))
+        `(,@(if (equal? r0 "eax") '()
+                `(("push___%eax")
+                  (,(string-append "mov____%" r0 ",%eax"))))
+          (,(string-append "mul____%" r1))
+          ,@(if (equal? r0 "eax") '()
+                `((,(string-append "mov____%eax,%" r0))
+                  ("pop____%eax"))))
+        `(("push___%eax")
+          ("push___%ebx")
+          ("push___%edx")
+          (,(string-append "mov____%" r1 ",%ebx"))
+          (,(string-append "mov____%" r0 ",%eax"))
+          (,(string-append "mul____%" r1))
+          ("pop____%edx")
+          ("pop____%ebx")
+          (,(string-append "mov____%eax,%" r0))
+          ("pop____%eax")))))
+
+(define (i386:r0<<r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "mov____%" r1 ",%ecx"))
+      (,(string-append "shl____%cl,%" r0)))))
+
+(define (i386:r0>>r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "mov____%" r1 ",%ecx"))
+      (,(string-append "shr____%cl,%" r0)))))
+
+(define (i386:r0-and-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "and____%" r1 ",%" r0)))))
+
+(define (i386:r0/r1 info)
+  (let ((allocated (.allocated info))
+        (r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    (if (not (member "edx" allocated))
+        `(,@(if (equal? r0 "eax") '()
+                `(("push___%eax")
+                  (,(string-append "mov____%" r0 ",%eax"))))
+          ("xor____%edx,%edx")
+          (,(string-append "idiv___%" r1))
+          ,@(if (equal? r0 "eax") '()
+                `((,(string-append "mov____%eax,%" r0))
+                  ("pop____%eax"))))
+        `(("push___%eax")
+          ("push___%ebx")
+          ("push___%edx")
+          (,(string-append "mov____%" r1 ",%ebx"))
+          (,(string-append "mov____%" r0 ",%eax"))
+          ("xor____%edx,%edx")
+          (,(string-append "idiv___%ebx"))
+          ("pop____%edx")
+          ("pop____%ebx")
+          (,(string-append "mov____%eax,%" r0))
+          ("pop____%eax")))))
+
+(define (i386:r0%r1 info)
+  (let ((allocated (.allocated info))
+        (r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    (if (not (member "edx" allocated))
+        `(,@(if (equal? r0 "eax") '()
+                `(("push___%eax")
+                  (,(string-append "mov____%" r0 ",%eax"))))
+          ("xor____%edx,%edx")
+          (,(string-append "idiv___%" r1))
+          (,(string-append "mov____%edx,%" r0)))
+        `(("push___%eax")
+          ("push___%ebx")
+          ("push___%edx")
+          (,(string-append "mov____%" r1 ",%ebx"))
+          (,(string-append "mov____%" r0 ",%eax"))
+          ("xor____%edx,%edx")
+          (,(string-append "idiv___%ebx"))
+          ("pop____%edx")
+          ("pop____%ebx")
+          (,(string-append "mov____%edx,%" r0))
+          ("pop____%eax")))))
+
+(define (i386:r+value info v)
+  (let ((r (get-r info)))
+    `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r) (#:immediate1 ,v))
+           `(,(string-append "add____$i32,%" r) (#:immediate ,v))))))
+
+(define (i386:r0->r1-mem info)
+  (let ((r0 (get-r0 info))
+         (r1 (get-r1 info)))
+    `((,(string-append "mov____%" r0 ",(%" r1 ")")))))
+
+(define (i386:byte-r0->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (l0 (e->l r0)))
+    `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
+
+(define (i386:word-r0->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (x0 (e->x r0)))
+    `((,(string-append "mov____%" x0 ",(%" r1 ")")))))
+
+(define (i386:r-cmp-value info v)
+  (let ((r (get-r info)))
+    `(,(if (< (abs v) #x80) `(,(string-append "cmp____$i8,%" r) (#:immediate1 ,v))
+           `(,(string-append "cmp____$i32,%" r) (#:immediate ,v))))))
+
+(define (i386:push-register info r)
+  `((,(string-append "push___%" r))))
+
+(define (i386:pop-register info r)
+  `((,(string-append "pop____%" r))))
+
+(define (i386:return->r info)
+  (let ((r (get-r info)))
+    (if (equal? r "eax") '()
+        `((,(string-append "mov____%eax,%" r))))))
+
+(define (i386:r0-or-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "or_____%" r1 ",%" r0)))))
+
+(define (i386:shl-r info n)
+  (let ((r (get-r info)))
+    `((,(string-append "shl____$i8,%" r) (#:immediate1 ,n)))))
+
+(define (i386:r+r info)
+  (let ((r (get-r info)))
+    `((,(string-append "add____%" r ",%" r)))))
+
+(define (i386:not-r info)
+  (let ((r (get-r info)))
+    `((,(string-append "not____%" r)))))
+
+(define (i386:r0-xor-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "xor____%" r1 ",%" r0)))))
+
+(define (i386:r0-mem->r1-mem info)
+  (let* ((registers (.registers info))
+         (r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (r2 (car registers)))
+    `((,(string-append "mov____(%" r0 "),%" r2))
+      (,(string-append "mov____%" r2 ",(%" r1 ")")))))
+
+(define (i386:r0+value info v)
+  (let ((r0 (get-r0 info)))
+    `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,%" r0) (#:immediate1 ,v))
+           `(,(string-append "add____$i32,%" r0) (#:immediate ,v))))))
 
 (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)))))
+  (let ((r0 (get-r0 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:byte-r->local+n info id n)
+  (let* ((n (+ (- 0 (* 4 id)) n))
+         (r (get-r info))
+         (l (e->l r) ))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____%" l ",0x8(%ebp)") (#:immediate1 ,n))
+           `(,(string-append "mov____%" l ",0x32(%ebp)") (#:immediate ,n))))))
+
+(define (i386:word-r->local+n info id n)
+  (let* ((n (+ (- 0 (* 4 id)) n))
+         (r (get-r info))
+         (x (e->x r)))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____%" x ",0x8(%ebp)") (#:immediate1 ,n))
+           `(,(string-append "mov____%" x ",0x32(%ebp)") (#:immediate ,n))))))
+
+(define (i386:r-and info v)
+  (let ((r (get-r info)))
+    `((,(string-append "and____$i32,%" r) (#:immediate ,v)))))
+
+(define (i386:push-r0 info)
+  (let ((r0 (get-r0 info)))
+    `((,(string-append "push___%" r0)))))
+
+(define (i386:r1->r0 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append  "mov____%" r1 ",%" r0)))))
+
+(define (i386:pop-r0 info)
+  (let ((r0 (get-r0 info)))
+    `((,(string-append "pop____%" r0)))))
+
+(define (i386:swap-r-stack info)
+  (let ((r (get-r info)))
+    `((,(string-append "xchg___%" r ",(%esp)")))))
+
+(define (i386:swap-r1-stack info)
+  (let ((r0 (get-r0 info)))
+    `((,(string-append "xchg___%" r0 ",(%esp)")))))
+
+(define (i386:r2->r0 info)
+  (let ((r0 (get-r0 info))
+        (allocated (.allocated info)))
+    (if (> (length allocated) 2)
+        (let ((r2 (cadddr allocated)))
+          `((,(string-append  "mov____%" r2 ",%" r1))))
+        `((,(string-append  "pop____%" r0))
+          (,(string-append  "push___%" r0))))))
 
 (define i386:instructions
   `(
+    (a?->r . ,i386:a?->r)
+    (ae?->r . ,i386:ae?->r)
+    (b?->r . ,i386:b?->r)
+    (be?->r . ,i386:be?->r)
+    (byte-mem->r . ,i386:byte-mem->r)
+    (byte-r . ,i386:byte-r)
+    (byte-r->local+n . ,i386:byte-r->local+n)
+    (byte-r0->r1-mem . ,i386:byte-r0->r1-mem)
+    (byte-r0->r1-mem . ,i386:byte-r0->r1-mem)
+    (byte-signed-r . ,i386:byte-signed-r)
     (call-label . ,i386:call-label)
-    (function-preamble . ,i386:function-preamble)
+    (call-r . ,i386:call-r)
     (function-locals . ,i386:function-locals)
-    (local->r0 . ,i386:local->r0)
-    (r0->local . ,i386:r0->local)
-    (r0-zero? . ,i386:r0-zero?)
+    (function-preamble . ,i386:function-preamble)
+    (g?->r . ,i386:g?->r)
+    (ge?->r . ,i386:ge?->r)
+    (jump . ,i386:jump)
+    (jump-a . ,i386:jump-a)
+    (jump-ae . ,i386:jump-ae)
+    (jump-b . ,i386:jump-b)
+    (jump-be . ,i386:jump-be)
+    (jump-byte-z . ,i386:jump-byte-z)
+    (jump-g . , i386:jump-g)
+    (jump-ge . , i386:jump-ge)
+    (jump-l . ,i386:jump-l)
+    (jump-le . ,i386:jump-le)
+    (jump-nz . ,i386:jump-nz)
+    (jump-z . ,i386:jump-z)
+    (l?->r . ,i386:l?->r)
+    (label->arg . ,i386:label->arg)
+    (label->r . ,i386:label->r)
+    (label-mem->r . ,i386:label-mem->r)
+    (label-mem-add . ,i386:label-mem-add)
+    (le?->r . ,i386:le?->r)
+    (local->r . ,i386:local->r)
+    (local-add . ,i386:local-add)
+    (local-ptr->r . ,i386:local-ptr->r)
+    (long-r0->r1-mem . ,i386:r0->r1-mem)
+    (mem->r . ,i386:mem->r)
+    (nop . ,i386:nop)
+    (not-r . ,i386:not-r)
+    (pop-r0 . ,i386:pop-r0)
+    (pop-register . ,i386:pop-register)
+    (push-r0 . ,i386:push-r0)
+    (push-register . ,i386:push-register)
+    (r+r . ,i386:r+r)
+    (r+value . ,i386:r+value)
+    (r->arg . ,i386:r->arg)
+    (r->label . ,i386:r->label)
+    (r->local . ,i386:r->local)
+    (r->local+n . ,i386:r->local+n)
+    (r-and . ,i386:r-and)
+    (r-byte-mem-add . ,i386:r-byte-mem-add)
+    (r-cmp-value . ,i386:r-cmp-value)
+    (r-mem-add . ,i386:r-mem-add)
+    (r-negate . ,i386:r-negate)
+    (r-word-mem-add . ,i386:r-word-mem-add)
+    (r-zero? . ,i386:r-zero?)
+    (r0%r1 . ,i386:r0%r1)
+    (r0*r1 . ,i386:r0*r1)
+    (r0+r1 . ,i386:r0+r1)
+    (r0+value . ,i386:r0+value)
+    (r0->r1 . ,i386:r0->r1)
+    (r0->r1-mem . ,i386:r0->r1-mem)
+    (r0-and-r1 . ,i386:r0-and-r1)
+    (r0-mem->r1-mem . ,i386:r0-mem->r1-mem)
+    (r0-or-r1 . ,i386:r0-or-r1)
+    (r0-r1 . ,i386:r0-r1)
+    (r0-xor-r1 . ,i386:r0-xor-r1)
+    (r0/r1 . ,i386:r0/r1)
+    (r0<<r1 . ,i386:r0<<r1)
+    (r0>>r1 . ,i386:r0>>r1)
+    (r1->r0 . ,i386:r1->r0)
+    (r2->r0 . ,i386:r2->r0)
     (ret . ,i386:ret)
+    (return->r . ,i386:return->r)
+    (shl-r . ,i386:shl-r)
+    (swap-r-stack . ,i386:swap-r-stack)
+    (swap-r0-r1 . ,i386:swap-r0-r1)
+    (swap-r1-stack . ,i386:swap-r1-stack)
+    (test-r . ,i386:test-r)
+    (value->r . ,i386:value->r)
     (value->r0 . ,i386:value->r0)
+    (word-mem->r . ,i386:word-mem->r)
+    (word-r . ,i386:word-r)
+    (word-r->local+n . ,i386:word-r->local+n)
+    (word-r0->r1-mem . ,i386:word-r0->r1-mem)
+    (word-signed-r . ,i386:word-signed-r)
+    (xor-zf . ,i386:xor-zf)
+    (zf->r . ,i386:zf->r)
     ))
index ed6f25f85e5799800701bc15b2f3ed167b80009f..11b97aa58ac3286bcfd23b5f246376f58845cb32 100644 (file)
 (define (x86-info)
   (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"))
+(define i386:registers '("eax" "ebx" "ecx" "edx" "esi" "edi"))
 (define i386:type-alist
   `(("char" . ,(make-type 'signed 1 #f))
     ("short" . ,(make-type 'signed 2 #f))
     ("int" . ,(make-type 'signed 4 #f))
     ("long" . ,(make-type 'signed 4 #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 4 #f))  ;; FIXME
+    ("*" . ,(make-type 'unsigned 4 #f))
+    ("long long" . ,(make-type 'signed 4 #f))
     ("long long int" . ,(make-type 'signed 4 #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 4 #f))
 
-    ;; ("unsigned long long" . ,(make-type 'builtin 8 #f))
-    ;; ("unsigned long long int" . ,(make-type 'builtin 8 #f))
-    ("unsigned long long" . ,(make-type 'unsigned 4 #f)) ;; FIXME
+    ("unsigned long long" . ,(make-type 'unsigned 4 #f))
     ("unsigned long long int" . ,(make-type 'unsigned 4 #f))
 
     ("float" . ,(make-type 'float 4 #f))
-    ("double" . ,(make-type 'float 8 #f))
-    ("long double" . ,(make-type 'float 16 #f))
+    ("double" . ,(make-type 'float 4 #f))
+    ("long double" . ,(make-type 'float 4 #f))
 
-    ;;
     ("short int" . ,(make-type 'signed 2 #f))
     ("unsigned short int" . ,(make-type 'unsigned 2 #f))
     ("long int" . ,(make-type 'signed 4 #f))
index bdb04d103db18b5170be2fb3f4aa0da101aa38b9..49ce33ab7800eb793e2afb3135368f0afbdbe8ca 100644 (file)
@@ -45,6 +45,7 @@
             .break
             .continue
             .allocated
+            .pushed
             .registers
             .instructions
 
             structured-type?))
 
 (define-immutable-record-type <info>
-  (make-<info> types constants functions globals locals statics function text post break continue allocated registers instructions)
+  (make-<info> types constants functions globals locals statics function text post break continue allocated pushed registers instructions)
   info?
   (types .types)
   (constants .constants)
   (break .break)
   (continue .continue)
   (allocated .allocated)
+  (pushed .pushed)
   (registers .registers)
   (instructions .instructions))
 
-(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()) (allocated '()) (registers '()) (instructions '()))
+(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()) (allocated '()) (pushed 0) (registers '()) (instructions '()))
   (cond ((eq? o <info>)
-         (make-<info> types constants functions globals locals statics function text post break continue allocated  registers instructions))))
+         (make-<info> types constants functions globals locals statics function text post break continue allocated  pushed registers instructions))))
 
 (define (clone o . rest)
   (cond ((info? o)
                (break (.break o))
                (continue (.continue o))
                (allocated (.allocated o))
+               (pushed (.pushed o))
                (registers (.registers o))
                (instructions (.instructions o)))
            (let-keywords rest
                           (break break)
                           (continue continue)
                           (allocated allocated)
+                          (pushed pushed)
                           (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))))))
+                         (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 #:pushed pushed #:registers registers #:instructions instructions))))))
 
 ;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
 ;;           (make-type 'enum 4 0 fields)
index aa2dc9f5a11a24e99719df859096216e11de49b6..9236914a04ed109ffed48dfb39db573e20b646f3 100644 (file)
   #:use-module (mes guile)
   #:export (c99-input->ast))
 
-(format (current-error-port) "*nyacc-version*=~a\n" *nyacc-version*)
+(when (getenv "MESC_DEBUG")
+  (format (current-error-port) "*nyacc-version*=~a\n" *nyacc-version*))
+
 ;; list of which rules you want progress reported
 (define need-progress
-  (assoc-ref
-   '(("0.85.3" (1 2 3))
-     ("0.86.0" (1 2 3)))
-   *nyacc-version*))
+  (or (assoc-ref
+       '(("0.85.3" (1 2 3))
+         ("0.86.0" (1 2 3)))
+       *nyacc-version*)
+      '(1 2 3)))
 
 (define (progress o)
   (when (and o (getenv "NYACC_DEBUG"))
index b5217e791ed9e17d5510b4e33bb6ead8a21dc7d0..9e3f525832edc08735228caf12ce564d5ad73a88 100644 (file)
   #:use-module (mes guile)
   #:use-module (mescc as)
   #:use-module (mescc info)
+  #:use-module (mescc x86_64 info)
   #:export (
             x86_64:instructions
             ))
 
-(define (x86_64:function-preamble . rest)
-  '(("push___%rbp")
+(define (r->e o)
+  (string-append "e" (string-drop o 1)))
+(define (r->x o)
+  (string-drop o 1))
+(define (r->l o)
+  (assoc-ref
+   '(("rax" . "al")
+     ("rdi" . "dil")
+     ("rsi" . "sil")
+     ("rdx" . "dl")
+     ("rcx" . "cl")
+     ("r8" . "r8b")
+     ("r9" . "r9b"))
+   o))
+
+;; AMD
+(define (x86_64:function-preamble info . rest)
+  (format (current-error-port) "rest=~s\n" 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")
-    ))
+    ("sub____$i32,%rbp" "%0x80")
+    ,@(list-head
+       '(("mov____%rdi,0x8(%rbp)" "!0x10")
+         ("mov____%rsi,0x8(%rbp)" "!0x18")
+         ("mov____%rdx,0x8(%rbp)" "!0x20")
+         ("mov____%rcx,0x8(%rbp)" "!0x28")
+         ("mov____%r8,0x8(%rbp)" "!0x30")
+         ("mov____%r9,0x8(%rbp)" "!0x38"))
+       (length (car rest)))))
+
+;; traditional
+(define (x86_64:function-preamble info . rest)
+  (format (current-error-port) "rest=~s\n" rest)
+  `(("push___%rbp")
+    ("mov____%rsp,%rbp")))
 
 (define (x86_64:function-locals . rest)
   `(
     ("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))))
+(define (x86_64:r->local info n)
+  (let ((r (get-r 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))))))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
+           `(,(string-append "mov____%" r ",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:value->r info v)
+  (or v (error "invalid value: x86_64:value->r: " v))
+  (let ((r (get-r info)))
+    `((,(string-append "mov____$i32,%" r) (#:immediate ,v)))))
 
+;; AMD
+(define (x86_64:ret . rest)
+  '(("add____$i32,%rbp" "%0x80")
+    ("mov____%rbp,%rsp")
+    ("pop____%rbp")
+    ("ret")))
+
+;; traditional
 (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:r-zero? info)
+  (let ((r (car (if (pair? (.allocated info)) (.allocated info) (.registers info)))))
+    `((,(string-append "test___%" r "," "%" r)))))
 
-(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))))
+(define (x86_64:local->r info n)
+  (let ((r (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))))))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____0x8(%rbp),%" r) (#:immediate1 ,n))
+           `(,(string-append "mov____0x32(%rbp),%" r) (#:immediate ,n))))))
 
 (define (x86_64:call-label info label n)
   `((call32 (#:offset ,label))
-    ;;("add____$i8,%esp" (#:immediate1 ,(* n 4)))
+    ("add____$i8,%rsp" (#:immediate1 ,(* n 8)))  ;; NOT AMD
     ))
 
+(define x86_64:calling-convention-registers '("rax" "rdi" "rsi" "rdx" "rcx" "r8" "r9"))
+
+;; AMD
+(define (x86_64:r->arg info i)
+  (let ((r (get-r info))
+        (r1 (list-ref x86_64:calling-convention-registers (1+ i))))
+    `((,(string-append "mov____%" r ",%" r1))))) ; debug fail-safe check
+
+(define (x86_64:label->arg info label i)
+  (let ((r0 (list-ref x86_64:registers (1+ i))))
+    `((,(string-append "mov____$i32,%" r0) (#:address ,label))))) ;; FIXME: 64 bits
+
+;; traditional
+(define (x86_64:r->arg info i)
+  (let ((r (get-r info)))
+    `((,(string-append "push___%" r)))))
+
+(define (x86_64:label->arg info label i)
+  `(("push___$i32" (#:address ,label))))
+
+(define (x86_64:r0+r1 info)
+  (let ((r1 (get-r1 info))
+        (r0 (get-r0 info)))
+    `((,(string-append "add____%" r1 ",%" r0)))))
+
+(define (x86_64:r-negate info)
+  (let* ((r (get-r info))
+         (l (r->l r)))
+    `((,(string-append "sete___%" l))
+      (,(string-append "movzbq_%" l ",%" r)))))
+
+(define (x86_64:r0-r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append "sub____%" r1 ",%" r0)))))
+
+(define (x86_64:zf->r info)
+  (let* ((r (get-r info))
+         (l (r->l r)))
+    `((,(string-append "sete___%" l))
+      (,(string-append "movzbq_%" l ",%" r)))))
+
+(define (x86_64:xor-zf info)
+  '(("lahf")
+    ("xor____$i8,%ah" (#:immediate1 #x40))
+    ("sahf")))
+
+(define (x86_64:r->local+n info id n)
+  (let ((n (+ (- 0 (* 8 id)) n))
+        (r (get-r info)))
+    `(,(if (< (abs n) #x80) `(,(string-append "mov____%" r ",0x8(%rbp)") (#:immediate1 ,n))
+           `(,(string-append "mov____%" r ",0x32(%rbp)") (#:immediate ,n))))))
+
+(define (x86_64:r-mem-add info v)
+  (let ((r (get-r info)))
+    `(,(if (< (abs v) #x80) `(,(string-append "add____$i8,(%" r ")") (#:immediate1 ,v))
+           `(,(string-append "add____$i32,(%" r ")") (#:immediate ,v))))))
+
+(define (x86_64:r-byte-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "addb___$i8,(%" r ")") (#:immediate1 ,v)))))
+
+(define (x86_64:r-word-mem-add info v)
+  (let ((r (get-r info)))
+    `((,(string-append "addw___$i8,(%" r ")") (#:immediate2 ,v)))))
+
+(define (x86_64:local-ptr->r info n)
+  (let ((r (get-r info)))
+    (let ((n (- 0 (* 8 n))))
+      `((,(string-append "mov____%rbp,%" r))
+        ,(if (< (abs n) #x80) `(,(string-append "add____$i8,%" r) (#:immediate1 ,n))
+             `(,(string-append "add____$i32,%" r)  (#:immediate ,n)))))))
+
+(define (x86_64:label->r info label)
+  (let ((r (get-r info)))
+    `((,(string-append "mov____$i32,%" r) (#:address ,label)))))
+
+(define (x86_64:r0->r1 info)
+  (let ((r0 (get-r0 info))
+        (r1 (get-r1 info)))
+    `((,(string-append  "mov____%" r0 ",%" r1)))))
+
+(define (x86_64:byte-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "movzbq_(%" r "),%" r)))))
+
+(define (x86_64:byte-r info)
+  (let* ((r (get-r info))
+         (l (r->l r)))
+    `((,(string-append "movzbq_%" l ",%" r)))))
+
+(define (x86_64:byte-signed-r info)
+  (let* ((r (get-r info))
+         (l (r->l r)))
+    `((,(string-append "movsbq_%" l ",%" r)))))
+
+(define (x86_64:word-r info)
+  (let* ((r (get-r info))
+         (x (r->x r)))
+    `((,(string-append "movzwq_%" x ",%" r)))))
+
+(define (x86_64:word-signed-r info)
+  (let* ((r (get-r info))
+         (x (r->x r)))
+    `((,(string-append "movswq_%" x ",%" r)))))
+
+(define (x86_64:long-r info)
+  (let* ((r (get-r info))
+         (e (r->e r)))
+    `((,(string-append "movzlq_%" e ",%" r)))))
+
+(define (x86_64:long-signed-r info)
+  (let* ((r (get-r info))
+         (e (r->e r)))
+    `((,(string-append "movslq_%" e ",%" r)))))
+
+(define (x86_64:jump info label)
+  `(("jmp32 " (#:offset ,label))))
+
+(define (x86_64:jump-nz info label)
+  `(("jne32 " (#:offset ,label))))
+
+(define (x86_64:jump-z info label)
+  `(("je32  " (#:offset ,label))))
+
+(define (x86_64:jump-byte-z info label)
+  `(("test___%al,%al")
+    ("je32  " (#:offset ,label))))
+
+;; signed
+(define (x86_64:jump-g info label)
+  `(("jg32  " (#:offset ,label))))
+
+(define (x86_64:jump-ge info  label)
+  `(("jge32 " (#:offset ,label))))
+
+(define (x86_64:jump-l info label)
+  `(("jl32  " (#:offset ,label))))
+
+(define (x86_64:jump-le info label)
+  `(("jle32 " (#:offset ,label))))
+
+;; unsigned
+(define (x86_64:jump-a info label)
+  `(("ja32  " (#:offset ,label))))
+
+(define (x86_64:jump-ae info label)
+  `(("jae32 " (#:offset ,label))))
+
+(define (x86_64:jump-b info label)
+  `(("jb32  " (#:offset ,label))))
+
+(define (x86_64:jump-be info label)
+  `(("jbe32 " (#:offset ,label))))
+
+(define (x86_64:byte-r0->r1-mem info)
+  (let* ((r0 (get-r0 info))
+         (r1 (get-r1 info))
+         (l0 (r->l r0)))
+    `((,(string-append "mov____%" l0 ",(%" r1 ")")))))
+
+(define (x86_64:label-mem->r info label)
+  (let ((r (get-r info)))
+    `((,(string-append "mov____0x32,%" r) (#:address ,label)))))
+
+(define (x86_64:word-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "movzwq_(%" r "),%" r)))))
+
+(define (x86_64:long-mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append "movzlq_(%" r "),%" r)))))
+
+(define (x86_64:mem->r info)
+  (let ((r (get-r info)))
+    `((,(string-append &