diff --git a/AUTHORS b/AUTHORS index 37da1a43..4e716b8f 100644 --- a/AUTHORS +++ b/AUTHORS @@ -12,11 +12,11 @@ Main author All files except the imported files listed below Jeremiah Orians -lib/libc+tcc.c (fopen) +lib/stdio/fopen.c (first simple version of fopen) scaffold/tests/98-fopen.c Han-Wen Nienhuys -lib/libc+tcc.c (_memmem, memmem) +lib/string/memmem.c (_memmem, memmem) rain1 scaffold/tests/90-goto-var.c diff --git a/build-aux/build-cc.sh b/build-aux/build-cc.sh index 02ca47ab..650728b4 100755 --- a/build-aux/build-cc.sh +++ b/build-aux/build-cc.sh @@ -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 diff --git a/build-aux/build-cc32.sh b/build-aux/build-cc32.sh index 404afe6e..2712b87e 100755 --- a/build-aux/build-cc32.sh +++ b/build-aux/build-cc32.sh @@ -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 diff --git a/build-aux/build-mes.sh b/build-aux/build-mes.sh index 4882dac1..6d23c71b 100755 --- a/build-aux/build-mes.sh +++ b/build-aux/build-mes.sh @@ -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 diff --git a/build-aux/build-x86_64-mes.sh b/build-aux/build-x86_64-mes.sh index c7eff73e..2d737b1d 100755 --- a/build-aux/build-x86_64-mes.sh +++ b/build-aux/build-x86_64-mes.sh @@ -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 diff --git a/build-aux/build.sh.in b/build-aux/build.sh.in index 4d3b6df9..0a5bbcda 100755 --- a/build-aux/build.sh.in +++ b/build-aux/build.sh.in @@ -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 diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh index 8abd15bd..918f87d0 100755 --- a/build-aux/check-mescc.sh +++ b/build-aux/check-mescc.sh @@ -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 diff --git a/build-aux/check-tcc.sh b/build-aux/check-tcc.sh index 75ddaf5c..85320597 100755 --- a/build-aux/check-tcc.sh +++ b/build-aux/check-tcc.sh @@ -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 diff --git a/build-aux/test64.sh b/build-aux/test64.sh index 4d29ca4b..93aee8d9 100755 --- a/build-aux/test64.sh +++ b/build-aux/test64.sh @@ -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 diff --git a/include/libmes.h b/include/libmes.h index e7224739..1a311da5 100644 --- a/include/libmes.h +++ b/include/libmes.h @@ -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); diff --git a/include/setjmp.h b/include/setjmp.h index fe413f8a..f2dee025 100644 --- a/include/setjmp.h +++ b/include/setjmp.h @@ -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 - diff --git a/include/signal.h b/include/signal.h index bd7e0404..21079bac 100644 --- a/include/signal.h +++ b/include/signal.h @@ -26,8 +26,8 @@ #else //! WITH_GLIBC -typedef int sigset_t; -typedef int stack_t; +typedef long sigset_t; +typedef long stack_t; #include @@ -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); diff --git a/include/stdarg.h b/include/stdarg.h index 08c38159..f56b0dd2 100644 --- a/include/stdarg.h +++ b/include/stdarg.h @@ -27,15 +27,13 @@ #include -#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 diff --git a/include/sys/stat.h b/include/sys/stat.h index c8a83cd4..17626f41 100644 --- a/include/sys/stat.h +++ b/include/sys/stat.h @@ -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); diff --git a/include/sys/types.h b/include/sys/types.h index 1e2f29a6..1efde1f4 100644 --- a/include/sys/types.h +++ b/include/sys/types.h @@ -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 diff --git a/include/unistd.h b/include/unistd.h index 0600a6e5..c34584cf 100644 --- a/include/unistd.h +++ b/include/unistd.h @@ -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); diff --git a/lib/libc+tcc.c b/lib/libc+tcc.c index 35fcdd16..a8b9a49d 100644 --- a/lib/libc+tcc.c +++ b/lib/libc+tcc.c @@ -35,6 +35,8 @@ #include +int errno; + #if __GNU__ #include #elif __linux__ @@ -43,8 +45,10 @@ #error both __GNU__ and _linux__ are undefined, choose one #endif -#if __MESC__ +#if __MESC__ && __i386__ #include +#elif __MESC__ && __x86_64__ +#include #elif __i386__ #include #elif __x86_64__ diff --git a/lib/linux/gnu.c b/lib/linux/gnu.c index 70dd5a2f..ecc2c3de 100644 --- a/lib/linux/gnu.c +++ b/lib/linux/gnu.c @@ -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); } +// 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) +{ + _sys_call (SYS_rt_sigreturn); +} + +# define __sigmask(sig) \ + (((unsigned long int) 1) << (((sig) - 1) % (8 * sizeof (unsigned long int)))) + +sighandler_t +signal (int signum, sighandler_t action) +{ #if __i386__ -#if __MESC__ -void * -signal (int signum, void * action) -#else -sighandler_t -signal (int signum, sighandler_t action) -#endif -{ return _sys_call2 (SYS_signal, signum, action); -} -#elif __x86_64__ -sighandler_t -signal (int signum, sighandler_t action) -{ - sighandler_t old; - _sys_call3 (SYS_rt_sigaction, signum, action, &old); - return old; -} #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 diff --git a/lib/linux/libc-mini.c b/lib/linux/libc-mini.c index 05cc339f..d303f3bb 100644 --- a/lib/linux/libc-mini.c +++ b/lib/linux/libc-mini.c @@ -20,22 +20,16 @@ #include -#if __MESC__ - +#if __MESC__ && __i386__ #include - +#elif __MESC__ && __x86_64__ +#include #elif __i386__ - #include - #elif __x86_64__ - #include - #else - #error arch not supported - #endif ssize_t diff --git a/lib/linux/libc.c b/lib/linux/libc.c index dd4aac7f..8231a778 100644 --- a/lib/linux/libc.c +++ b/lib/linux/libc.c @@ -18,31 +18,26 @@ * along with GNU Mes. If not, see . */ +#include + #include #include #include -#include #include #include #include #include -#if __MESC__ - +#if __MESC__ && __i386__ #include - +#elif __MESC__ && __x86_64__ +#include #elif __i386__ - #include - #elif __x86_64__ - #include - #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); } diff --git a/lib/linux/tcc.c b/lib/linux/tcc.c index 59c2128d..f912db8a 100644 --- a/lib/linux/tcc.c +++ b/lib/linux/tcc.c @@ -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 diff --git a/lib/linux/x86-mes-gcc/crt1.c b/lib/linux/x86-mes-gcc/crt1.c index 1e9c9791..0b9cc182 100644 --- a/lib/linux/x86-mes-gcc/crt1.c +++ b/lib/linux/x86-mes-gcc/crt1.c @@ -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 () diff --git a/lib/linux/x86_64-mes-gcc/crt1.c b/lib/linux/x86_64-mes-gcc/crt1.c index e1c6619c..a1be28ee 100644 --- a/lib/linux/x86_64-mes-gcc/crt1.c +++ b/lib/linux/x86_64-mes-gcc/crt1.c @@ -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, , diff --git a/lib/linux/x86_64-mes-gcc/mes.c b/lib/linux/x86_64-mes-gcc/mes.c index 27dc56f6..5e4d6b9e 100644 --- a/lib/linux/x86_64-mes-gcc/mes.c +++ b/lib/linux/x86_64-mes-gcc/mes.c @@ -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) { diff --git a/lib/linux/x86_64-mes/crt1.c b/lib/linux/x86_64-mes/crt1.c index a63c8bee..fc33fdd9 100644 --- a/lib/linux/x86_64-mes/crt1.c +++ b/lib/linux/x86_64-mes/crt1.c @@ -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 index 00000000..e87656b3 --- /dev/null +++ b/lib/linux/x86_64-mes/mes.c @@ -0,0 +1,123 @@ +/* -*-comment-start: "//";comment-end:""-*- + * GNU Mes --- Maxwell Equations of Software + * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen + * + * 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 . + */ + +#include +#include + +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 index 00000000..c5816727 --- /dev/null +++ b/lib/linux/x86_64-mes/mini.c @@ -0,0 +1,43 @@ +/* -*-comment-start: "//";comment-end:""-*- + * GNU Mes --- Maxwell Equations of Software + * Copyright © 2018 Jan (janneke) Nieuwenhuizen + * + * 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 . + */ + +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"); +} diff --git a/lib/mes/abtol.c b/lib/mes/abtol.c index bf0ba9c1..69ec50a6 100644 --- a/lib/mes/abtol.c +++ b/lib/mes/abtol.c @@ -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; diff --git a/lib/posix/mktemp.c b/lib/posix/mktemp.c index 256db921..0c7e5164 100644 --- a/lib/posix/mktemp.c +++ b/lib/posix/mktemp.c @@ -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'; diff --git a/lib/posix/wait.c b/lib/posix/wait.c index 5d1d6f40..a9bb1f4c 100644 --- a/lib/posix/wait.c +++ b/lib/posix/wait.c @@ -20,7 +20,7 @@ #include -int +pid_t wait (int *status_ptr) { return waitpid (-1, status_ptr, 0); diff --git a/lib/stdio/fopen.c b/lib/stdio/fopen.c index b0227a01..2a73ddd3 100644 --- a/lib/stdio/fopen.c +++ b/lib/stdio/fopen.c @@ -22,6 +22,12 @@ #include #include +//#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 diff --git a/lib/stdio/fputc.c b/lib/stdio/fputc.c index bcadbc3f..264a2af3 100644 --- a/lib/stdio/fputc.c +++ b/lib/stdio/fputc.c @@ -23,5 +23,5 @@ int fputc (int c, FILE* stream) { - return fdputc (c, (long)stream); + return fdputc (c, (int)stream); } diff --git a/lib/stdio/fseek.c b/lib/stdio/fseek.c index 91e687c2..f53c7b72 100644 --- a/lib/stdio/fseek.c +++ b/lib/stdio/fseek.c @@ -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)); diff --git a/lib/stdio/printf.c b/lib/stdio/printf.c index f9787ab8..95ad3d4e 100644 --- a/lib/stdio/printf.c +++ b/lib/stdio/printf.c @@ -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; } diff --git a/lib/stdio/sprintf.c b/lib/stdio/sprintf.c index 2cc90a17..5edf9306 100644 --- a/lib/stdio/sprintf.c +++ b/lib/stdio/sprintf.c @@ -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; } diff --git a/lib/stdio/vfprintf.c b/lib/stdio/vfprintf.c index 57cf079b..1e3cc3ea 100644 --- a/lib/stdio/vfprintf.c +++ b/lib/stdio/vfprintf.c @@ -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; diff --git a/lib/stdio/vsprintf.c b/lib/stdio/vsprintf.c index 2194f68e..41147db8 100644 --- a/lib/stdio/vsprintf.c +++ b/lib/stdio/vsprintf.c @@ -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; diff --git a/lib/stdio/vsscanf.c b/lib/stdio/vsscanf.c index 9f2568a8..e1604448 100644 --- a/lib/stdio/vsscanf.c +++ b/lib/stdio/vsscanf.c @@ -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*); diff --git a/lib/stdlib/qsort.c b/lib/stdlib/qsort.c index 22f493e2..237f121d 100644 --- a/lib/stdlib/qsort.c +++ b/lib/stdlib/qsort.c @@ -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 } } diff --git a/lib/x86-mes-gcc/setjmp.c b/lib/x86-mes-gcc/setjmp.c index 050e227a..3643b464 100644 --- a/lib/x86-mes-gcc/setjmp.c +++ b/lib/x86-mes-gcc/setjmp.c @@ -19,24 +19,12 @@ */ #include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -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; } diff --git a/lib/x86-mes/setjmp.c b/lib/x86-mes/setjmp.c index 99bdd303..db3dc4a3 100644 --- a/lib/x86-mes/setjmp.c +++ b/lib/x86-mes/setjmp.c @@ -19,23 +19,12 @@ */ #include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -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; diff --git a/lib/x86-mes/x86.M1 b/lib/x86-mes/x86.M1 index 978f3309..937191a3 100644 --- a/lib/x86-mes/x86.M1 +++ b/lib/x86-mes/x86.M1 @@ -1,5 +1,5 @@ ### GNU Mes --- Maxwell Equations of Software -### Copyright © 2017 Jan (janneke) Nieuwenhuizen +### Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen ### ### This file is part of GNU Mes. ### @@ -16,40 +16,41 @@ ### You should have received a copy of the GNU General Public License ### along with GNU Mes. If not, see . +# 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 diff --git a/lib/x86_64-mes-gcc/setjmp.c b/lib/x86_64-mes-gcc/setjmp.c index ae372638..8967b0fd 100644 --- a/lib/x86_64-mes-gcc/setjmp.c +++ b/lib/x86_64-mes-gcc/setjmp.c @@ -19,57 +19,31 @@ */ #include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -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 index 00000000..85a9ef0e --- /dev/null +++ b/lib/x86_64-mes/setjmp.c @@ -0,0 +1,71 @@ +/* -*-comment-start: "//";comment-end:""-*- + * GNU Mes --- Maxwell Equations of Software + * Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen + * + * 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 . + */ + +#include + +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; +} diff --git a/lib/x86_64-mes/x86_64.M1 b/lib/x86_64-mes/x86_64.M1 index 10e6b913..70785ef9 100644 --- a/lib/x86_64-mes/x86_64.M1 +++ b/lib/x86_64-mes/x86_64.M1 @@ -16,38 +16,293 @@ ### You should have received a copy of the GNU General Public License ### along with GNU Mes. If not, see . +# 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 diff --git a/mes/module/mescc/x86_64/as.mes b/mes/module/mescc/x86_64/as.mes index e83f3f62..f18591a3 100644 --- a/mes/module/mescc/x86_64/as.mes +++ b/mes/module/mescc/x86_64/as.mes @@ -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") diff --git a/mes/module/nyacc/version.mes b/mes/module/nyacc/version.mes index b9db628e..386e9dcd 100644 --- a/mes/module/nyacc/version.mes +++ b/mes/module/nyacc/version.mes @@ -23,4 +23,3 @@ ;;; Code: (include-from-path "nyacc/version.scm") -(display "nyacc version\n") diff --git a/module/mescc/M1.scm b/module/mescc/M1.scm index 7ee1de71..7ee083eb 100644 --- a/module/mescc/M1.scm +++ b/module/mescc/M1.scm @@ -69,6 +69,14 @@ (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))) @@ -119,6 +128,8 @@ ((#: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) @@ -147,6 +158,7 @@ (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)))) diff --git a/module/mescc/as.scm b/module/mescc/as.scm index b2e650d0..a91e18d8 100644 --- a/module/mescc/as.scm +++ b/module/mescc/as.scm @@ -25,7 +25,17 @@ 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))) @@ -48,5 +58,20 @@ (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))) diff --git a/module/mescc/bytevectors.scm b/module/mescc/bytevectors.scm index 1bb01981..fe2e4311 100644 --- a/module/mescc/bytevectors.scm +++ b/module/mescc/bytevectors.scm @@ -22,12 +22,28 @@ (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 diff --git a/module/mescc/compile.scm b/module/mescc/compile.scm index e57541d6..a9504f64 100644 --- a/module/mescc/compile.scm +++ b/module/mescc/compile.scm @@ -42,6 +42,12 @@ 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))) @@ -57,21 +63,18 @@ #: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) @@ -80,21 +83,17 @@ (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 : ~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 :" o)))) (define (ast->type o info) @@ -129,8 +128,8 @@ ((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)))) @@ -173,10 +172,10 @@ (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)) @@ -256,11 +255,10 @@ ((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) @@ -277,11 +275,11 @@ ((,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) @@ -306,7 +304,7 @@ (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)))))))) @@ -315,7 +313,7 @@ (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))) @@ -324,11 +322,11 @@ (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))) @@ -350,7 +348,7 @@ (_ (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)))) @@ -387,7 +385,7 @@ ((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) @@ -408,53 +406,17 @@ (->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))) @@ -462,63 +424,25 @@ (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) @@ -526,284 +450,242 @@ (if (assoc-ref globals string) globals (append globals (list (string->global-entry o))))))) -(define (ident->accu info) +(define (ident->r 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))))))) + (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))))))) -(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 (value->r o info) + (wrap-as (as info 'value->r o))) -(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) - (lambda (o) - (cond ((assoc-ref (.locals info) o) => (cut local->r0 info <>)) - - ((assoc-ref (.statics info) o) => global->accu) - ((assoc-ref (filter (negate static-global?) (.globals info)) o) => global->accu) - ((assoc-ref (.constants info) o) => number->accu) - (else (list (i386:label->accu `(#:address ,o)))) - - - ;; ((assoc-ref (.statics info) o) => (cut global->r0 info <>)) - ;; ((assoc-ref (filter (negate static-global?) (.globals info)) o) => (cut global->r0 info <>)) - ;; ((assoc-ref (.constants info) o) => (cut number->r0 info <>)) - ;; (else (wrap-as (as info 'label->r0 `(#:address ,o)))) - ))) - -(define (local->r0 info o) +(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) +(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->r info) (lambda (o) (cond ((assoc-ref (.locals info) o) => - (lambda (local) (wrap-as (i386:local-ptr->accu (local:id local))))) + (lambda (local) (wrap-as (as info 'local-ptr->r (local:id local))))) ((assoc-ref (.statics info) o) => - (lambda (global) (list (i386:label->accu `(#:address ,global))))) + (lambda (global) (wrap-as (as info 'label->r `(#: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))))))) + (lambda (global) (wrap-as (as info 'label->r `(#:address ,global))))) + (else (wrap-as (as info 'label->r `(#:address ,o))))))) -(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 (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 (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 (r->ident 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) (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 (r0->ident info) - (lambda (o) - (cond ((assoc-ref (.locals info) o) - => - (lambda (local) (let ((size (->size local))) - (if (<= size 4) (wrap-as (as info 'r0->local (local:id local))) - (wrap-as (i386:accu*n->local (local:id local) size)) - ;;(wrap-as (as info 'r0*n->local (local:id local) size)) - )))) - ((assoc-ref (.statics info) o) - => - (lambda (global) (let ((size (->size global))) - (if (<= size 4) (wrap-as (i386:accu->label global)) - (wrap-as (i386:accu*n->label global size)))))) - ((assoc-ref (filter (negate static-global?) (.globals info)) o) - => - (lambda (global) (let ((size (->size global))) - (if (<= size 4) (wrap-as (i386:accu->label global)) - (wrap-as (i386:accu*n->label global size))))))))) - -(define (value->ident info) - (lambda (o value) - (cond ((assoc-ref (.locals info) o) - => - (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)))) + (lambda (local) (wrap-as (as info 'local-add (local:id local) n)))) ((assoc-ref (.statics info) o) => - (lambda (global) (list (i386:label-mem-add `(#:address ,o) n)))) + (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 (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))))) - ((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)))))) - ((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 (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)) -(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)))))))))) + (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 (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 (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 - )) + (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 (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 (push-register r info) + (append-text info (wrap-as (as info 'push-register r)))) -(define (r0->r1-mem*n info n) - ;;(append-text info (r0->r1-mem*n- info n)) - (append-text info (accu->base-mem*n- info n)) - ) +(define (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)) @@ -812,27 +694,31 @@ (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)) @@ -842,44 +728,87 @@ (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))))))) + (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)) + (post (clone info #:text '())) + (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) reg-size) + (else 1))) + (post ((expr-add post) expr (- size)))) + (clone info #:post (.text post)))) + + ((post-inc ,expr) + (let* ((info (expr->register* expr info)) + (post (clone info #:text '())) + (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) reg-size) + (else 1))) + (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) 4) + ((> rank 1) reg-size) (else 1))) (info ((expr-add info) expr (- size))) (info (append (expr->register* expr info)))) @@ -887,102 +816,94 @@ ((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)))) 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)))) - (rank (expr->rank post expr)) - (size (cond ((= rank 1) (ast-type->size post expr)) - ((> rank 1) 4) - (else 1))) - (post ((expr-add post) expr (- size))) - (post (append-text post (wrap-as (i386:pop-accu))))) - (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)))) - (rank (expr->rank post expr)) - (size (cond ((= rank 1) (ast-type->size post expr)) - ((> rank 1) 4) - (else 1))) - (post ((expr-add post) expr size)) - (post (append-text post (wrap-as (i386:pop-accu))))) - (clone info #:post (.text post)))) - (_ (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)) @@ -994,12 +915,14 @@ ((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)) @@ -1009,99 +932,137 @@ (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)))) @@ -1109,8 +1070,9 @@ ((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)))) @@ -1122,138 +1084,166 @@ (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)))) - (if (and (not (= rank-b 2)) (not (= rank-b 1))) info - (append-text info (wrap-as (append (i386:value->base size) - (i386:accu/base)))))) - (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))) + (if (or (= size 1) (or (= rank-b 2) (= rank-b 1))) + (let ((info ((binop->r info) a b 'r0-r1))) + (if (and (not (= rank-b 2)) (not (= rank-b 1))) info + ;; 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 (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<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<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))))) + (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)) - ;; 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)))) - - ((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)) @@ -1261,31 +1251,34 @@ (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) @@ -1294,168 +1287,167 @@ (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<>=") (wrap-as (as info 'r0>>r1))) + ((equal? op "<<=") (wrap-as (as info 'r0<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)) @@ -1468,32 +1460,35 @@ (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)) @@ -1532,9 +1527,9 @@ ((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) @@ -1551,7 +1546,7 @@ (_ #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) @@ -1562,14 +1557,10 @@ (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))) @@ -1586,10 +1577,10 @@ (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)) @@ -1618,7 +1609,6 @@ (_ (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)) @@ -1638,17 +1628,20 @@ ((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)))) @@ -1656,9 +1649,10 @@ ((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))))) @@ -1668,7 +1662,7 @@ (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))) @@ -1681,7 +1675,7 @@ (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)))))) @@ -1690,18 +1684,8 @@ ;; 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) @@ -1730,10 +1714,10 @@ (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 @@ -1750,14 +1734,16 @@ (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 @@ -1771,14 +1757,14 @@ (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 @@ -1798,7 +1784,7 @@ (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 @@ -1810,38 +1796,39 @@ (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)) @@ -1850,19 +1837,20 @@ (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) @@ -1871,7 +1859,7 @@ ((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))) @@ -1889,8 +1877,13 @@ 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))) @@ -1898,33 +1891,36 @@ ((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))))))) @@ -1992,76 +1988,127 @@ ((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 n 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)) @@ -2078,14 +2125,15 @@ (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)) @@ -2094,7 +2142,7 @@ (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)) @@ -2115,20 +2163,25 @@ (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)))) @@ -2136,7 +2189,20 @@ (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)) @@ -2158,7 +2224,7 @@ (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)))) @@ -2260,47 +2326,58 @@ (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))) @@ -2346,23 +2423,23 @@ ((struct-def (field-list . ,fields)) (mescc:trace name " ") (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 " ") (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 " ") - (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 " ") - (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) @@ -2374,7 +2451,6 @@ ((void) info) (_ ;;(error "type->info: not supported:" o) - (stderr "type->info: not supported: ~s\n" o) info ))) @@ -2382,11 +2458,11 @@ (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))) @@ -2465,16 +2541,15 @@ (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) @@ -2507,7 +2582,8 @@ (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 diff --git a/module/mescc/i386/as.scm b/module/mescc/i386/as.scm index d617a0e8..836789d3 100644 --- a/module/mescc/i386/as.scm +++ b/module/mescc/i386/as.scm @@ -27,142 +27,15 @@ #: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: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") @@ -171,559 +44,569 @@ (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