diff options
66 files changed, 6739 insertions, 561 deletions
diff --git a/HOWTO/INSTALL-ANDROID.md b/HOWTO/INSTALL-ANDROID.md new file mode 100644 index 0000000000..31698d4ce3 --- /dev/null +++ b/HOWTO/INSTALL-ANDROID.md @@ -0,0 +1,52 @@ +Cross Compiling Erlang/OTP - ANDROID +==================================== + +Introduction +------------ + +This document describes how to cross compile Erlang OTP to Android/Rasberry Pi platforms. + +### Download and Install Android NDK ### + +https://developer.android.com/tools/sdk/ndk/index.html + +### Define System Variables ### + +export NDK_ROOT=/usr/local/android +export NDK_PLAT=android-9 +export PATH=$NDK_ROOT/toolchains/arm-linux-androideabi-4.8/prebuilt/darwin-x86_64/bin:$PATH + +### Configure OTP ### + +./otp_build configure \ + --xcomp-conf=./xcomp/erl-xcomp-arm-android.conf \ + --without-ssl + +### Compile OTP ### + +make noboot [-j4] + +### Make Release ### + +./otp_build release -a /usr/local/otp_R16B03_arm + +### Target Deployment ### + +Make a tarball out of /usr/local/otp_R16B03_arm and copy it to target device +(e.g. Raspberry Pi). Extract it and install + +./Install /usr/local/otp_R16B03_arm + +Android SDK (adb tool) is used to deploy OTP/Erlang to target device for +evaluation purpose only. + +adb push /usr/local/otp_R16B03_arm /mnt/sdcard/otp_R16B03_arm +adb shell + +### Known Issues ### + + * native inet:gethostbyname/1 return {error, nxdomain} on Raspberry PI. Use dns resolver to by-pass the issue (see http://www.erlang.org/doc/apps/erts/inet_cfg.html) + +### References ### + + The port derives some solutions from https://code.google.com/p/erlang4android/ diff --git a/configure.in b/configure.in index f6cccb4f4b..be906dcb4e 100644 --- a/configure.in +++ b/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1998-2012. All Rights Reserved. +dnl Copyright Ericsson AB 1998-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -209,7 +209,7 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support])) AC_ARG_ENABLE(halfword-emulator, AS_HELP_STRING([--enable-halfword-emulator], - [enable halfword emulator (only for 64bit builds)])) + [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.])) AC_ARG_ENABLE(smp-support, AS_HELP_STRING([--enable-smp-support], [enable smp support]) diff --git a/erts/configure.in b/erts/configure.in index 074882532f..208c294106 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2013. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -144,7 +144,7 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]), AC_ARG_ENABLE(halfword-emulator, AS_HELP_STRING([--enable-halfword-emulator], - [enable halfword emulator (only for 64bit builds)]), + [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.]), [ case "$enableval" in no) enable_halfword_emualtor=no ;; *) enable_halfword_emulator=yes ;; @@ -816,6 +816,16 @@ if test "$enable_halfword_emulator" = "yes"; then [Define if building a halfword-heap 64bit emulator]) ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS halfword" AC_MSG_RESULT([yes]) + + test -f "$ERL_TOP/erts/CONF_INFO" || + echo "" > "$ERL_TOP/erts/CONF_INFO" + cat >> $ERL_TOP/erts/CONF_INFO <<EOF + + The HALFWORD emulator has been enabled. + This is a DEPRECATED feature scheduled for removal + in a future major release. + +EOF else AC_MSG_ERROR(no; halfword emulator not supported on this architecture) fi @@ -1151,7 +1161,7 @@ fi AC_SUBST(ERTS_BUILD_SMP_EMU) -AC_CHECK_FUNCS([posix_fadvise]) +AC_CHECK_FUNCS([posix_fadvise closefrom]) AC_CHECK_HEADERS([linux/falloc.h]) dnl * Old glibcs have broken fallocate64(). Make sure not to use it. AC_CACHE_CHECK([whether fallocate() works],i_cv_fallocate_works,[ diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 2a9a0a5c2f..58e77ed1fa 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -378,7 +378,9 @@ LIBS += -l$(ERTS_INTERNAL_LIB)$(TYPEMARKER) endif # erts_internal_r +ifneq ($(TARGET),arm-unknown-linux-androideabi) LIBS += @LIBRT@ +endif LIBS += @LIBCARBON@ diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index e273056a2b..05f07e57b2 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -154,10 +154,14 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; /* In VC++, noreturn is a declspec that has to be before the types, * but in GNUC it is an att ribute to be placed between return type * and function name, hence __decl_noreturn <types> __noreturn <function name> + * + * at some platforms (e.g. Android) __noreturn is defined at sys/cdef.h */ #if __GNUC__ # define __decl_noreturn -# define __noreturn __attribute__((noreturn)) +# ifndef __noreturn +# define __noreturn __attribute__((noreturn)) +# endif #else # if defined(__WIN32__) && defined(_MSC_VER) # define __noreturn diff --git a/erts/emulator/drivers/common/gzio.c b/erts/emulator/drivers/common/gzio.c index ef539f8f9b..1ef1602ec9 100644 --- a/erts/emulator/drivers/common/gzio.c +++ b/erts/emulator/drivers/common/gzio.c @@ -230,6 +230,7 @@ local ErtsGzFile gz_open (path, mode) errno = 0; #if defined(FILENAMES_16BIT) { + FILE* efile_wfopen(const WCHAR* name, const WCHAR* mode); WCHAR wfmode[80]; int i = 0; int j; @@ -237,7 +238,7 @@ local ErtsGzFile gz_open (path, mode) wfmode[i++] = (WCHAR) fmode[j]; } wfmode[i++] = L'\0'; - s->file = _wfopen((WCHAR *)path, wfmode); + s->file = efile_wfopen((WCHAR *)path, wfmode); if (s->file == NULL) { return s->destroy(s), (ErtsGzFile)Z_NULL; } diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c index 3fe5d282dc..3143e4511d 100644 --- a/erts/emulator/drivers/common/zlib_drv.c +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -21,6 +21,9 @@ * ZLib interface for erlang * */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif #include <stdio.h> #include <zlib.h> #include <errno.h> diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 480ba23239..a321bb9641 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -29,12 +29,27 @@ #include <wchar.h> #include "erl_efile.h" +#define DBG_TRACE_MASK 0 +/* 1 = file name ops + * 2 = file descr ops + * 4 = errors + * 8 = path name conversion + */ +#if !DBG_TRACE_MASK +# define DBG_TRACE(M,S) +# define DBG_TRACE1(M,FMT,A) +# define DBG_TRACE2(M,FMT,A,B) +#else +# define DBG_TRACE(M,S) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: %s\r\n", __LINE__, (WCHAR*)(S)); }while(0) +# define DBG_TRACE1(M,FMT,A) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: " L##FMT L"\r\n", __LINE__, (A)); }while(0) +# define DBG_TRACE2(M,FMT,A,B) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: " L##FMT L"\r\n", __LINE__, (A), (B)); }while(0) +#endif + /* * Microsoft-specific function to map a WIN32 error code to a Posix errno. */ #define ISSLASH(a) ((a) == L'\\' || (a) == L'/') - #define ISDIR(st) (((st).st_mode&S_IFMT) == S_IFDIR) #define ISREG(st) (((st).st_mode&S_IFMT) == S_IFREG) @@ -69,10 +84,92 @@ static int check_error(int result, Efile_error* errInfo); static int set_error(Efile_error* errInfo); +static int set_os_errno(Efile_error* errInfo, DWORD os_errno); static int is_root_unc_name(const WCHAR *path); static int extract_root(WCHAR *name); static unsigned short dos_to_posix_mode(int attr, const WCHAR *name); + +struct wpath_tmp_buffer { + struct wpath_tmp_buffer* next; + WCHAR buffer[1]; +}; + +typedef struct { + Efile_error* errInfo; + struct wpath_tmp_buffer* buf_list; +}Efile_call_state; + +static void call_state_init(Efile_call_state* state, Efile_error* errInfo) +{ + state->errInfo = errInfo; + state->buf_list = NULL; +} +static WCHAR* wpath_tmp_alloc(Efile_call_state* state, size_t len) +{ + size_t sz = offsetof(struct wpath_tmp_buffer, buffer) + + (len+1)*sizeof(WCHAR); + struct wpath_tmp_buffer* p = driver_alloc(sz); + p->next = state->buf_list; + state->buf_list = p; + return p->buffer; +} +static void call_state_free(Efile_call_state* state) +{ + while(state->buf_list) { + struct wpath_tmp_buffer* next = state->buf_list->next; + driver_free(state->buf_list); + state->buf_list = next; + } +} +static WCHAR* get_cwd_wpath_tmp(Efile_call_state* state) +{ + WCHAR dummy; + DWORD size = GetCurrentDirectoryW(0, &dummy); + WCHAR* ret = NULL; + + if (size) { + ret = wpath_tmp_alloc(state, size); + if (!GetCurrentDirectoryW(size, ret)) { + ret = NULL; + } + } + return ret; +} +static WCHAR* get_full_wpath_tmp(Efile_call_state* state, + const WCHAR* file, + WCHAR** file_part, + DWORD extra) +{ + WCHAR dummy; + DWORD size = GetFullPathNameW(file, 0, &dummy, NULL); + WCHAR* ret = NULL; + + if (size) { + int ok; + ret = wpath_tmp_alloc(state, size + extra); + if (file_part) { + ok = (GetFullPathNameW(file, size, ret, file_part) != 0); + } + else { + ok = (_wfullpath(ret, file, size) != NULL); + } + if (!ok) { + ret = NULL; + } + } + return ret; +} + +static void ensure_wpath_max(Efile_call_state* state, WCHAR** pathp, size_t max); +static int do_rmdir(Efile_call_state*, char* name); +static int do_rename(Efile_call_state*, char* src, char* dst); +static int do_readdir(Efile_call_state*, char* name, EFILE_DIR_HANDLE*, char* buffer, size_t *size); +static int do_fileinfo(Efile_call_state*, Efile_info*, char* orig_name, int info_for_link); +static char* do_readlink(Efile_call_state*, char* name, char* buffer, size_t size); +static int do_altname(Efile_call_state*, char* orig_name, char* buffer, size_t size); + + static int errno_map(DWORD last_error) { switch (last_error) { @@ -154,6 +251,8 @@ static int errno_map(DWORD last_error) { return EAGAIN; case ERROR_CANT_RESOLVE_FILENAME: return EMLINK; + case ERROR_PRIVILEGE_NOT_HELD: + return EPERM; case ERROR_ARENA_TRASHED: case ERROR_INVALID_BLOCK: case ERROR_BAD_ENVIRONMENT: @@ -176,11 +275,23 @@ check_error(int result, Efile_error* errInfo) if (result < 0) { errInfo->posix_errno = errno; errInfo->os_errno = GetLastError(); + DBG_TRACE2(4, "ERROR os_error=%d errno=%d @@@@@@@@@@@@@@@@@@@@@@@@@@@@", + errInfo->os_errno, errInfo->posix_errno); return 0; } return 1; } +static void +save_last_error(Efile_error* errInfo) +{ + errInfo->posix_errno = errno; + errInfo->os_errno = GetLastError(); + DBG_TRACE2(4, "ERROR os_error=%d errno=%d $$$$$$$$$$$$$$$$$$$$$$$$$$$$$", + errInfo->os_errno, errInfo->posix_errno); +} + + /* * Fills the provided error information structure with information * with the error code given by GetLastError() and its corresponding @@ -192,7 +303,18 @@ check_error(int result, Efile_error* errInfo) static int set_error(Efile_error* errInfo) { - errInfo->posix_errno = errno_map(errInfo->os_errno = GetLastError()); + set_os_errno(errInfo, GetLastError()); + return 0; +} + + +static int +set_os_errno(Efile_error* errInfo, DWORD os_errno) +{ + errInfo->os_errno = os_errno; + errInfo->posix_errno = errno_map(os_errno); + DBG_TRACE2(4, "ERROR os_error=%d errno=%d ############################", + errInfo->os_errno, errInfo->posix_errno); return 0; } @@ -226,21 +348,151 @@ win_writev(Efile_error* errInfo, } +/* Check '*pathp' and convert it if needed to something that windows will accept. + * Typically use UNC path with \\?\ prefix if absolute path is longer than 260. + */ +static void ensure_wpath(Efile_call_state* state, WCHAR** pathp) +{ + ensure_wpath_max(state, pathp, MAX_PATH); +} + +static void ensure_wpath_max(Efile_call_state* state, WCHAR** pathp, size_t max) +{ + WCHAR* path = *pathp; + WCHAR* p; + size_t len = wcslen(path); + int unc_fixup = 0; + + if (path[0] == 0) { + DBG_TRACE(8, L"Let empty path pass through"); + return; + } + + DBG_TRACE1(8,"IN: %s", path); + + if (path[1] == L':' && ISSLASH(path[2])) { /* absolute path */ + if (len >= max) { + WCHAR *src, *dst; + + *pathp = wpath_tmp_alloc(state, 4+len+1); + dst = *pathp; + wcscpy(dst, L"\\\\?\\"); + for (src=path,dst+=4; *src; src++) { + if (*src == L'/') { + if (dst[-1] != L'\\') { + *dst++ = L'\\'; + } + /*else ignore redundant slashes */ + } + else + *dst++ = *src; + } + *dst = 0; + unc_fixup = 1; + } + } + else if (!(ISSLASH(path[0]) && ISSLASH(path[1]))) { /* relative path */ + DWORD cwdLen = GetCurrentDirectoryW(0, NULL); + DWORD absLen = cwdLen + 1 + len; + if (absLen >= max) { + WCHAR *fullPath = wpath_tmp_alloc(state, 4+4+absLen); + DWORD fullLen; + + fullLen = GetFullPathNameW(path, 4 + absLen, fullPath+4, NULL); + if (fullLen >= 4+absLen) { + *pathp = path; + DBG_TRACE2(8,"ensure_wpath FAILED absLen=%u %s", (int)absLen, path); + return; + } + /* GetFullPathNameW can return paths longer than MAX_PATH without the \\?\ prefix. + * At least seen on Windows 7. Go figure... + */ + if (fullLen >= max && wcsncmp(fullPath+4, L"\\\\?\\", 4) != 0) { + wcsncpy(fullPath, L"\\\\?\\", 4); + *pathp = fullPath; + } + else { + *pathp = fullPath + 4; + } + } + } + + if (unc_fixup) { + WCHAR* endp; + + p = *pathp; + len = wcslen(p); + endp = p + len; + if (len > 4) { + p += 4; + while (*p) { + if (p[0] == L'\\' && p[1] == L'.') { + if (p[2] == L'\\' || !p[2]) { /* single dot */ + wmemmove(p, p+2, (&endp[1] - &p[2])); + endp -= 2; + } + else if (p[2] == L'.' && (p[3] == L'\\' || !p[3])) { /* double dot */ + WCHAR* r; + for (r=p-1; *r == L'\\'; --r) + /*skip redundant slashes*/; + for (; *r != L'\\'; --r) + /*find start of prev directory*/; + if (r < *pathp + 6) + break; + wmemmove(r, p+3, (&endp[1] - &p[3])); + p = r; + } + else p += 3; + } + else ++p; + } + } + } + DBG_TRACE1(8,"OUT: %s", *pathp); +} int efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of directory to create. */ { - return check_error(_wmkdir((WCHAR *) name), errInfo); + Efile_call_state state; + WCHAR* wname = (WCHAR*)name; + int ret; + + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ensure_wpath_max(&state, &wname, 248); /* Yes, 248 limit for normal paths */ + + ret = (int) CreateDirectoryW(wname, NULL); + if (!ret) + set_error(errInfo); + + call_state_free(&state); + return ret; } int efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of directory to delete. */ { + Efile_call_state state; + int ret; + + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ret = do_rmdir(&state, name); + call_state_free(&state); + return ret; +} + +static int do_rmdir(Efile_call_state* state, char* name) +{ OSVERSIONINFO os; DWORD attr; WCHAR *wname = (WCHAR *) name; + WCHAR *buffer = NULL; + + ensure_wpath(state, &wname); if (RemoveDirectoryW(wname) != FALSE) { return 1; @@ -270,10 +522,9 @@ efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ if (os.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) { HANDLE handle; WIN32_FIND_DATAW data; - WCHAR buffer[2*MAX_PATH]; - int len; + int len = wcslen(wname); - len = wcslen(wname); + buffer = wpath_tmp_alloc(state, len + 4); wcscpy(buffer, wname); if (buffer[0] && buffer[len-1] != L'\\' && buffer[len-1] != L'/') { wcscat(buffer, L"\\"); @@ -311,16 +562,30 @@ efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ } end: - return check_error(-1, errInfo); + save_last_error(state->errInfo); + return 0; } int efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of file to delete. */ { + Efile_call_state state; + int ret; + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ret = do_delete_file(&state, name); + call_state_free(&state); + return ret; +} + +static int do_delete_file(Efile_call_state* state, char* name) +{ DWORD attr; WCHAR *wname = (WCHAR *) name; + ensure_wpath(state, &wname); + if (DeleteFileW(wname) != FALSE) { return 1; } @@ -359,7 +624,7 @@ efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ errno = EACCES; } - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } /* @@ -393,14 +658,29 @@ efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ */ int -efile_rename(Efile_error* errInfo, /* Where to return error codes. */ - char* src, /* Original name. */ - char* dst) /* New name. */ +efile_rename(Efile_error* errInfo, char* src, char* dst) +{ + Efile_call_state state; + int ret; + DBG_TRACE(1, src); + call_state_init(&state, errInfo); + ret = do_rename(&state, src, dst); + call_state_free(&state); + return ret; +} + +static int +do_rename(Efile_call_state* state, + char* src, /* Original name. */ + char* dst) /* New name. */ { DWORD srcAttr, dstAttr; WCHAR *wsrc = (WCHAR *) src; WCHAR *wdst = (WCHAR *) dst; - + + ensure_wpath(state, &wsrc); + ensure_wpath(state, &wdst); + if (MoveFileW(wsrc, wdst) != FALSE) { return 1; } @@ -417,23 +697,27 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ if (errno == EBADF) { errno = EACCES; - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } if (errno == EACCES) { decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { - WCHAR srcPath[MAX_PATH], dstPath[MAX_PATH]; + WCHAR *srcPath, *dstPath; WCHAR *srcRest, *dstRest; int size; - size = GetFullPathNameW(wsrc, MAX_PATH, srcPath, &srcRest); - if ((size == 0) || (size > MAX_PATH)) { - return check_error(-1, errInfo); + srcPath = get_full_wpath_tmp(state, wsrc, &srcRest, 0); + if (!srcPath) { + save_last_error(state->errInfo); + return 0; } - size = GetFullPathNameW(wdst, MAX_PATH, dstPath, &dstRest); - if ((size == 0) || (size > MAX_PATH)) { - return check_error(-1, errInfo); + + dstPath = get_full_wpath_tmp(state, wdst, &dstRest, 0); + if (!dstPath) { + save_last_error(state->errInfo); + return 0; } + if (srcRest == NULL) { srcRest = srcPath + wcslen(srcPath); } @@ -538,14 +822,16 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ * put temp file back to old name. */ - WCHAR tempName[MAX_PATH]; - int result, size; + WCHAR *tempName; + int result; WCHAR *rest; - size = GetFullPathNameW(wdst, MAX_PATH, tempName, &rest); - if ((size == 0) || (size > MAX_PATH) || (rest == NULL)) { - return check_error(-1, errInfo); + tempName = get_full_wpath_tmp(state, wdst, &rest, 14); + if (!tempName || !rest) { + save_last_error(state->errInfo); + return 0; } + *rest = L'\0'; result = -1; if (GetTempFileNameW(tempName, L"erlr", 0, tempName) != 0) { @@ -578,7 +864,6 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ /* * Decode the EACCES to a more meaningful error. */ - goto decode; } } @@ -586,16 +871,20 @@ efile_rename(Efile_error* errInfo, /* Where to return error codes. */ } } } - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } int efile_chdir(Efile_error* errInfo, /* Where to return error codes. */ char* name) /* Name of directory to make current. */ -{ - int success = check_error(_wchdir((WCHAR *) name), errInfo); - if (!success && errInfo->posix_errno == EINVAL) - /* POSIXification of errno */ +{
+ /* We don't even try to handle long paths here
+ * as current working directory is always limited to MAX_PATH
+ * even if we use UNC paths and SetCurrentDirectoryW()
+ */
+ int success = check_error(_wchdir((WCHAR *) name), errInfo);
+ if (!success && errInfo->posix_errno == EINVAL)
+ /* POSIXification of errno */
errInfo->posix_errno = ENOENT; return success; } @@ -608,28 +897,45 @@ efile_getdcwd(Efile_error* errInfo, /* Where to return error codes. */ { WCHAR *wbuffer = (WCHAR *) buffer; size_t wbuffer_size = size / 2; - if (_wgetdcwd(drive, wbuffer, wbuffer_size) == NULL) + DBG_TRACE(1, L"#getdcwd#"); + if (_wgetdcwd(drive, wbuffer, wbuffer_size) == NULL) { return check_error(-1, errInfo); + } + DBG_TRACE1(8, "getdcwd OS=%s", wbuffer); + if (wcsncmp(wbuffer, L"\\\\?\\", 4) == 0) { + wmemmove(wbuffer, wbuffer+4, wcslen(wbuffer+4)+1); + } for ( ; *wbuffer; wbuffer++) if (*wbuffer == L'\\') *wbuffer = L'/'; + DBG_TRACE1(8, "getdcwd ERLANG=%s", (WCHAR*)buffer); return 1; } int -efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ - char* name, /* Name of directory to list */ - EFILE_DIR_HANDLE* dir_handle, /* Handle of opened directory or NULL */ - char* buffer, /* Buffer to put one filename in */ - size_t *size) /* in-out size of buffer/size of filename excluding zero - termination in bytes*/ +efile_readdir(Efile_error* errInfo, char* name, EFILE_DIR_HANDLE* dir_handle, + char* buffer, size_t *size) +{ + Efile_call_state state; + int ret; + DBG_TRACE(dir_handle?2:1, name); + call_state_init(&state, errInfo); + ret = do_readdir(&state, name, dir_handle, buffer, size); + call_state_free(&state); + return ret; +} + +static int do_readdir(Efile_call_state* state, + char* name, /* Name of directory to list */ + EFILE_DIR_HANDLE* dir_handle, /* Handle of opened directory or NULL */ + char* buffer, /* Buffer to put one filename in */ + size_t *size) /* in-out size of buffer/size of filename excluding zero + termination in bytes*/ { HANDLE dir; /* Handle to directory. */ - WCHAR wildcard[MAX_PATH]; /* Wildcard to search for. */ WIN32_FIND_DATAW findData; /* Data found by FindFirstFile() or FindNext(). */ /* Alignment is not honored, this works on x86 because of alignment fixup by processor. Not perfect, but faster than alinging by hand (really) */ - WCHAR *wname = (WCHAR *) name; WCHAR *wbuffer = (WCHAR *) buffer; /* @@ -637,13 +943,15 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ */ if (*dir_handle == NULL) { - int length = wcslen(wname); + WCHAR *wname = (WCHAR *) name; + WCHAR* wildcard; + int length; WCHAR* s; - if (length+3 >= MAX_PATH) { - errno = ENAMETOOLONG; - return check_error(-1, errInfo); - } + ensure_wpath_max(state, &wname, MAX_PATH-2); + length = wcslen(wname); + + wildcard = wpath_tmp_alloc(state, length+3); wcscpy(wildcard, wname); s = wildcard+length-1; @@ -653,8 +961,10 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ *++s = L'\0'; DEBUGF(("Reading %ws\n", wildcard)); dir = FindFirstFileW(wildcard, &findData); - if (dir == INVALID_HANDLE_VALUE) - return set_error(errInfo); + if (dir == INVALID_HANDLE_VALUE) { + set_error(state->errInfo); + return 0; + } *dir_handle = (EFILE_DIR_HANDLE) dir; if (!IS_DOT_OR_DOTDOT(findData.cFileName)) { @@ -664,7 +974,6 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ } } - /* * Retrieve the name of the next file using the directory handle. */ @@ -681,24 +990,36 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ } if (GetLastError() == ERROR_NO_MORE_FILES) { - FindClose(dir); - errInfo->posix_errno = errInfo->os_errno = 0; - return 0; + state->errInfo->posix_errno = state->errInfo->os_errno = 0; + } + else { + set_error(state->errInfo); } - - set_error(errInfo); FindClose(dir); return 0; } } int -efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ - char* name, /* Name of directory to open. */ - int flags, /* Flags to use for opening. */ - int* pfd, /* Where to store the file descriptor. */ - Sint64* pSize) /* Where to store the size of the file. */ +efile_openfile(Efile_error* errInfo, char* name, int flags, int* pfd, Sint64* pSize) { + Efile_call_state state; + int ret; + DBG_TRACE1(1, "openfile(%s)", name); + call_state_init(&state, errInfo); + ret = do_openfile(&state, name, flags, pfd, pSize); + call_state_free(&state); + return ret; +} + +static +int do_openfile(Efile_call_state* state, /* Where to return error codes. */ + char* name, /* Name of directory to open. */ + int flags, /* Flags to use for opening. */ + int* pfd, /* Where to store the file descriptor. */ + Sint64* pSize) /* Where to store the size of the file. */ +{ + Efile_error* errInfo = state->errInfo; BY_HANDLE_FILE_INFORMATION fileInfo; /* File information from a handle. */ HANDLE fd; /* Handle to open file. */ DWORD access; /* Access mode: GENERIC_READ, GENERIC_WRITE. */ @@ -735,6 +1056,7 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ if (flags & EFILE_MODE_EXCL) { crFlags = CREATE_NEW; } + ensure_wpath(state, &wname); fd = CreateFileW(wname, access, FILE_SHARE_FLAGS, NULL, crFlags, flagsAndAttrs, NULL); @@ -777,34 +1099,56 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ } int -efile_may_openfile(Efile_error* errInfo, char *name) { +efile_may_openfile(Efile_error* errInfo, char *name) +{ + Efile_call_state state; WCHAR *wname = (WCHAR *) name; DWORD attr; + int ret; + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ensure_wpath(&state, &wname); if ((attr = GetFileAttributesW(wname)) == INVALID_FILE_ATTRIBUTES) { errno = ENOENT; - return check_error(-1, errInfo); + ret = check_error(-1, errInfo); } - - if (attr & FILE_ATTRIBUTE_DIRECTORY) { + else if (attr & FILE_ATTRIBUTE_DIRECTORY) { errno = EISDIR; - return check_error(-1, errInfo); + ret = check_error(-1, errInfo); } - return 1; + else ret = 1; + + call_state_free(&state); + return ret; } void efile_closefile(fd) int fd; /* File descriptor for file to close. */ { + DBG_TRACE(2, L""); CloseHandle((HANDLE) fd); } +FILE* efile_wfopen(const WCHAR* name, const WCHAR* mode) +{ + Efile_call_state state; + Efile_error dummy; + FILE* f; + call_state_init(&state, &dummy); + ensure_wpath(&state, (WCHAR**)&name); + f = _wfopen(name, mode); + call_state_free(&state); + return f; +} + int efile_fdatasync(errInfo, fd) Efile_error* errInfo; /* Where to return error codes. */ int fd; /* File descriptor for file to sync. */ { + DBG_TRACE(2, L""); /* Not available in Windows, just call regular fsync */ return efile_fsync(errInfo, fd); } @@ -814,6 +1158,7 @@ efile_fsync(errInfo, fd) Efile_error* errInfo; /* Where to return error codes. */ int fd; /* File descriptor for file to sync. */ { + DBG_TRACE(2, L""); if (!FlushFileBuffers((HANDLE) fd)) { return check_error(-1, errInfo); } @@ -824,64 +1169,87 @@ int efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, char* orig_name, int info_for_link) { + Efile_call_state state; + int ret; + DBG_TRACE(1, L""); + call_state_init(&state, errInfo); + ret = do_fileinfo(&state, pInfo, orig_name, info_for_link); + call_state_free(&state); + return ret; +} + +static int +do_fileinfo(Efile_call_state* state, Efile_info* pInfo, + char* orig_name, int info_for_link) +{ + Efile_error* errInfo = state->errInfo; HANDLE findhandle; /* Handle returned by FindFirstFile(). */ WIN32_FIND_DATAW findbuf; /* Data return by FindFirstFile(). */ - WCHAR name[_MAX_PATH]; + WCHAR* name = NULL; + WCHAR* win_path; int name_len; - WCHAR *path; - WCHAR pathbuf[_MAX_PATH]; int drive; /* Drive for filename (1 = A:, 2 = B: etc). */ - WCHAR *worig_name = (WCHAR *) orig_name; + WCHAR *worig_name = (WCHAR *) orig_name; + ensure_wpath(state, &worig_name); /* Don't allow wildcards to be interpreted by system */ - if (wcspbrk(worig_name, L"?*")) { - enoent: - errInfo->posix_errno = ENOENT; - errInfo->os_errno = ERROR_FILE_NOT_FOUND; - return 0; - } /* * Move the name to a buffer and make sure to remove a trailing * slash, because it causes FindFirstFile() to fail on Win95. */ - if ((name_len = wcslen(worig_name)) >= _MAX_PATH) { - goto enoent; - } else { - wcscpy(name, worig_name); - if (name_len > 2 && ISSLASH(name[name_len-1]) && - name[name_len-2] != L':') { - name[name_len-1] = L'\0'; - } + name_len = wcslen(worig_name); + + name = wpath_tmp_alloc(state, name_len+1); + wcscpy(name, worig_name); + if (name_len > 2 && ISSLASH(name[name_len-1]) && + name[name_len-2] != L':') { + name[name_len-1] = L'\0'; } - + + win_path = name; + if (wcsncmp(name, L"\\\\?\\", 4) == 0) { + win_path += 4; + } + + if (wcspbrk(win_path, L"?*")) { + enoent: + errInfo->posix_errno = ENOENT; + errInfo->os_errno = ERROR_FILE_NOT_FOUND; + return 0; + } + /* Try to get disk from name. If none, get current disk. */ - if (name[1] != L':') { + if (win_path[1] != L':') { + WCHAR* cwd_path = get_cwd_wpath_tmp(state); drive = 0; - if (GetCurrentDirectoryW(_MAX_PATH, pathbuf) && - pathbuf[1] == L':') { - drive = towlower(pathbuf[0]) - L'a' + 1; + if (cwd_path[1] == L':') { + drive = towlower(cwd_path[0]) - L'a' + 1; } - } else if (*name && name[2] == L'\0') { + } else if (*win_path && win_path[2] == L'\0') { /* * X: and nothing more is an error. */ errInfo->posix_errno = ENOENT; errInfo->os_errno = ERROR_FILE_NOT_FOUND; return 0; - } else - drive = towlower(*name) - L'a' + 1; + } else { + drive = towlower(*win_path) - L'a' + 1; + } findhandle = FindFirstFileW(name, &findbuf); if (findhandle == INVALID_HANDLE_VALUE) { + WCHAR* path = NULL; + if (!(wcspbrk(name, L"./\\") && - (path = _wfullpath(pathbuf, name, _MAX_PATH)) && + (path = get_full_wpath_tmp(state, name, NULL, 0)) && /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */ ((wcslen(path) == 3) || is_root_unc_name(path)) && (GetDriveTypeW(path) > 1) ) ) { + errInfo->posix_errno = ENOENT; errInfo->os_errno = ERROR_FILE_NOT_FOUND; return 0; @@ -908,13 +1276,11 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, /* * given that we know this is a symlink, we should be able to find its target */ - WCHAR target_name[_MAX_PATH]; - if (efile_readlink(errInfo, (char *) name, - (char *) target_name, - _MAX_PATH * sizeof(WCHAR)) == 1) { + WCHAR* target_name = (WCHAR*) do_readlink(state, (char *) name, NULL, 0); + if (target_name) { FindClose(findhandle); - return efile_fileinfo(errInfo, pInfo, - (char *) target_name, info_for_link); + return do_fileinfo(state, pInfo, + (char *) target_name, info_for_link); } } @@ -981,6 +1347,20 @@ efile_write_info(Efile_error* errInfo, Efile_info* pInfo, char* name) { + Efile_call_state state; + int ret; + call_state_init(&state, errInfo); + ret = do_write_info(&state, pInfo, name); + call_state_free(&state); + return ret; +} + +static int +do_write_info(Efile_call_state* state, + Efile_info* pInfo, + char* name) +{ + Efile_error* errInfo = state->errInfo; SYSTEMTIME timebuf; FILETIME ModifyFileTime; FILETIME AccessFileTime; @@ -990,6 +1370,10 @@ efile_write_info(Efile_error* errInfo, DWORD tempAttr; WCHAR *wname = (WCHAR *) name; + DBG_TRACE(1, name); + + ensure_wpath(state, &wname); + /* * Get the attributes for the file. */ @@ -1066,7 +1450,9 @@ char* buf; /* Buffer to write. */ size_t count; /* Number of bytes to write. */ Sint64 offset; /* where to write it */ { - int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + int res; + DBG_TRACE(2, L""); + res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); if (res) { return efile_write(errInfo, EFILE_MODE_WRITE, fd, buf, count); } else { @@ -1084,7 +1470,9 @@ char* buf; /* Buffer to read into. */ size_t count; /* Number of bytes to read. */ size_t* pBytesRead; /* Where to return number of bytes read. */ { - int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + int res; + DBG_TRACE(2, L""); + res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); if (res) { return efile_read(errInfo, EFILE_MODE_READ, fd, buf, count, pBytesRead); } else { @@ -1106,6 +1494,7 @@ size_t count; /* Number of bytes to write. */ OVERLAPPED overlapped; OVERLAPPED* pOverlapped = NULL; + DBG_TRACE(2, L""); if (flags & EFILE_MODE_APPEND) { memset(&overlapped, 0, sizeof(overlapped)); overlapped.Offset = 0xffffffff; @@ -1135,6 +1524,7 @@ efile_writev(Efile_error* errInfo, /* Where to return error codes */ OVERLAPPED overlapped; OVERLAPPED* pOverlapped = NULL; + DBG_TRACE(2, L""); ASSERT(iovcnt >= 0); if (flags & EFILE_MODE_APPEND) { @@ -1171,6 +1561,8 @@ size_t count; /* Number of bytes to read. */ size_t* pBytesRead; /* Where to return number of bytes read. */ { DWORD nbytes = 0; + + DBG_TRACE(2, L""); if (!ReadFile((HANDLE) fd, buf, count, &nbytes, NULL)) return set_error(errInfo); @@ -1190,6 +1582,7 @@ Sint64* new_location; /* Resulting new location in file. */ { LARGE_INTEGER off, new_loc; + DBG_TRACE(2, L""); switch (origin) { case EFILE_SEEK_SET: origin = FILE_BEGIN; break; case EFILE_SEEK_CUR: origin = FILE_CURRENT; break; @@ -1221,6 +1614,7 @@ Efile_error* errInfo; /* Where to return error codes. */ int *fd; /* File descriptor for file to truncate. */ int flags; { + DBG_TRACE(2, L""); if (!SetEndOfFile((HANDLE) (*fd))) return set_error(errInfo); return 1; @@ -1373,9 +1767,24 @@ dos_to_posix_mode(int attr, const WCHAR *name) return uxmode; } + int efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) { + Efile_call_state state; + int ret; + DBG_TRACE(1, name); + call_state_init(&state, errInfo); + ret = !!do_readlink(&state, name, buffer, size); + call_state_free(&state); + return ret; +} + +/* If buffer==0, return buffer allocated by wpath_tmp_allocate +*/ +static char* +do_readlink(Efile_call_state* state, char* name, char* buffer, size_t size) +{ /* * load dll and see if we have CreateSymbolicLink at runtime: * (Vista only) @@ -1383,6 +1792,9 @@ efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) HINSTANCE hModule = NULL; WCHAR *wname = (WCHAR *) name; WCHAR *wbuffer = (WCHAR *) buffer; + DWORD wsize = size / sizeof(WCHAR); + char* ret = NULL; + if ((hModule = LoadLibrary("kernel32.dll")) != NULL) { typedef DWORD (WINAPI * GETFINALPATHNAMEBYHANDLEPTR)( HANDLE hFile, @@ -1393,58 +1805,84 @@ efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) GETFINALPATHNAMEBYHANDLEPTR pGetFinalPathNameByHandle = (GETFINALPATHNAMEBYHANDLEPTR)GetProcAddress(hModule, "GetFinalPathNameByHandleW"); - if (pGetFinalPathNameByHandle == NULL) { - FreeLibrary(hModule); - } else { + if (pGetFinalPathNameByHandle != NULL) { + DWORD fileAttributes; + ensure_wpath(state, &wname); /* first check if file is a symlink; {error, einval} otherwise */ - DWORD fileAttributes = GetFileAttributesW(wname); + fileAttributes = GetFileAttributesW(wname); if ((fileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) { - BOOLEAN success = 0; + DWORD success = 0; HANDLE h = CreateFileW(wname, GENERIC_READ, FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); int len; if(h != INVALID_HANDLE_VALUE) { - success = pGetFinalPathNameByHandle(h, wbuffer, size / sizeof(WCHAR),0); - /* GetFinalPathNameByHandle prepends path with "\\?\": */ - len = wcslen(wbuffer); - wmemmove(wbuffer,wbuffer+4,len-3); - if (len - 4 >= 2 && wbuffer[1] == L':' && wbuffer[0] >= L'A' && - wbuffer[0] <= L'Z') { - wbuffer[0] = wbuffer[0] + L'a' - L'A'; + if (!wbuffer) { /* dynamic allocation */ + WCHAR dummy; + wsize = pGetFinalPathNameByHandle(h, &dummy, 0, 0); + if (wsize) { + wbuffer = wpath_tmp_alloc(state, wsize); + } } + if (wbuffer + && (success = pGetFinalPathNameByHandle(h, wbuffer, wsize, 0)) + && success < wsize) { + WCHAR* wp; + + /* GetFinalPathNameByHandle prepends path with "\\?\": */ + len = wcslen(wbuffer); + wmemmove(wbuffer,wbuffer+4,len-3); + if (len - 4 >= 2 && wbuffer[1] == L':' && wbuffer[0] >= L'A' && + wbuffer[0] <= L'Z') { + wbuffer[0] = wbuffer[0] + L'a' - L'A'; + } - for ( ; *wbuffer; wbuffer++) - if (*wbuffer == L'\\') - *wbuffer = L'/'; + for (wp=wbuffer ; *wp; wp++) + if (*wp == L'\\') + *wp = L'/'; + } CloseHandle(h); - } - FreeLibrary(hModule); + } if (success) { - return 1; + ret = (char*) wbuffer; } else { - return set_error(errInfo); + set_error(state->errInfo); } } else { - FreeLibrary(hModule); errno = EINVAL; - return check_error(-1, errInfo); + save_last_error(state->errInfo); } + goto done; } } errno = ENOTSUP; - return check_error(-1, errInfo); + save_last_error(state->errInfo); + +done: + if (hModule) + FreeLibrary(hModule); + return ret; } int efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) { + Efile_call_state state; + int ret; + DBG_TRACE(1, orig_name); + call_state_init(&state, errInfo); + ret = do_altname(&state, orig_name, buffer, size); + call_state_free(&state); + return ret; +} + +static int +do_altname(Efile_call_state* state, char* orig_name, char* buffer, size_t size) +{ WIN32_FIND_DATAW wfd; HANDLE fh; - WCHAR name[_MAX_PATH+1]; + WCHAR* name; int name_len; - WCHAR* path; - WCHAR pathbuf[_MAX_PATH+1]; /* Unclear weather GetCurrentDirectory will access one char after - _MAX_PATH */ + WCHAR* full_path = NULL; WCHAR *worig_name = (WCHAR *) orig_name; WCHAR *wbuffer = (WCHAR *) buffer; int drive; /* Drive for filename (1 = A:, 2 = B: etc). */ @@ -1453,8 +1891,8 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) if (wcspbrk(worig_name, L"?*")) { enoent: - errInfo->posix_errno = ENOENT; - errInfo->os_errno = ERROR_FILE_NOT_FOUND; + state->errInfo->posix_errno = ENOENT; + state->errInfo->os_errno = ERROR_FILE_NOT_FOUND; return 0; } @@ -1462,24 +1900,23 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) * Move the name to a buffer and make sure to remove a trailing * slash, because it causes FindFirstFile() to fail on Win95. */ - - if ((name_len = wcslen(worig_name)) >= _MAX_PATH) { - goto enoent; - } else { - wcscpy(name, worig_name); - if (name_len > 2 && ISSLASH(name[name_len-1]) && - name[name_len-2] != L':') { - name[name_len-1] = L'\0'; - } + ensure_wpath(state, &worig_name); + name_len = wcslen(worig_name); + + name = wpath_tmp_alloc(state, name_len + 1); + wcscpy(name, worig_name); + if (name_len > 2 && ISSLASH(name[name_len-1]) && + name[name_len-2] != L':') { + name[name_len-1] = L'\0'; } /* Try to get disk from name. If none, get current disk. */ if (name[1] != L':') { + WCHAR* cwd_path = get_cwd_wpath_tmp(state); drive = 0; - if (GetCurrentDirectoryW(_MAX_PATH, pathbuf) && - pathbuf[1] == L':') { - drive = towlower(pathbuf[0]) - L'a' + 1; + if (cwd_path[1] == L':') { + drive = towlower(cwd_path[0]) - L'a' + 1; } } else if (*name && name[2] == L'\0') { /* @@ -1491,13 +1928,15 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) } fh = FindFirstFileW(name,&wfd); if (fh == INVALID_HANDLE_VALUE) { + DWORD fff_error = GetLastError(); if (!(wcspbrk(name, L"./\\") && - (path = _wfullpath(pathbuf, name, _MAX_PATH)) && + (full_path = get_full_wpath_tmp(state, name, NULL, 0)) && /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */ - ((wcslen(path) == 3) || is_root_unc_name(path)) && - (GetDriveTypeW(path) > 1) ) ) { - errno = errno_map(GetLastError()); - return check_error(-1, errInfo); + ((wcslen(full_path) == 3) || is_root_unc_name(full_path)) && + (GetDriveTypeW(full_path) > 1) ) ) { + + set_os_errno(state->errInfo, fff_error); + return 0; } /* * Root directories (such as C:\ or \\server\share\ are fabricated. @@ -1518,17 +1957,37 @@ efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) int efile_link(Efile_error* errInfo, char* old, char* new) { + Efile_call_state state; WCHAR *wold = (WCHAR *) old; WCHAR *wnew = (WCHAR *) new; + int ret; + DBG_TRACE(1, old); + call_state_init(&state, errInfo); + ensure_wpath(&state, &wold); + ensure_wpath(&state, &wnew); if(!CreateHardLinkW(wnew, wold, NULL)) { - return set_error(errInfo); + ret = set_error(errInfo); } - return 1; + else ret =1; + call_state_free(&state); + return ret; } int efile_symlink(Efile_error* errInfo, char* old, char* new) { + Efile_call_state state; + int ret; + DBG_TRACE2(1, "symlink(%s <- %s)", old, new); + call_state_init(&state, errInfo); + ret = do_symlink(&state, old, new); + call_state_free(&state); + return ret; +} + +static int +do_symlink(Efile_call_state* state, char* old, char* new) +{ /* * Load dll and see if we have CreateSymbolicLink at runtime: * (Vista only) @@ -1536,6 +1995,8 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) HINSTANCE hModule = NULL; WCHAR *wold = (WCHAR *) old; WCHAR *wnew = (WCHAR *) new; + + DBG_TRACE(1, old); if ((hModule = LoadLibrary("kernel32.dll")) != NULL) { typedef BOOLEAN (WINAPI * CREATESYMBOLICLINKFUNCPTR) ( LPCWSTR lpSymlinkFileName, @@ -1547,6 +2008,9 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) "CreateSymbolicLinkW"); /* A for MBCS, W for UNICODE... char* above implies 'W'! */ if (pCreateSymbolicLink != NULL) { + ensure_wpath(state, &wold); + ensure_wpath(state, &wnew); + { DWORD attr = GetFileAttributesW(wold); int flag = (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) ? 1 : 0; @@ -1557,19 +2021,21 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) if (success) { return 1; } else { - return set_error(errInfo); + return set_error(state->errInfo); } + } } else FreeLibrary(hModule); } errno = ENOTSUP; - return check_error(-1, errInfo); + return check_error(-1, state->errInfo); } int efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length, int advise) { + DBG_TRACE(2, L""); /* posix_fadvise is not available on Windows, do nothing */ errno = ERROR_SUCCESS; return check_error(0, errInfo); @@ -1578,6 +2044,7 @@ efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, int efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length) { + DBG_TRACE(2, L""); /* No file preallocation method available in Windows. */ errno = errno_map(ERROR_NOT_SUPPORTED); SetLastError(ERROR_NOT_SUPPORTED); diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index 7637049bc3..054911e822 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -182,3 +182,10 @@ BIF_RETTYPE hipe_bifs_debug_native_called_2(BIF_ALIST_2) BIF_RET(am_ok); } +/* Stub-BIF for LLVM: + * Reloads BP, SP (in llvm unwind label) */ + +BIF_RETTYPE hipe_bifs_llvm_fix_pinned_regs_0(BIF_ALIST_0) +{ + BIF_RET(am_ok); +} diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab index 45a395bf57..1b659cfa90 100644 --- a/erts/emulator/hipe/hipe_bif2.tab +++ b/erts/emulator/hipe/hipe_bif2.tab @@ -30,3 +30,4 @@ bif hipe_bifs:in_native/0 bif hipe_bifs:modeswitch_debug_on/0 bif hipe_bifs:modeswitch_debug_off/0 bif hipe_bifs:debug_native_called/2 +bif hipe_bifs:llvm_fix_pinned_regs/0 diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 7c6e4a2f37..94eb6b1547 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -54,6 +54,17 @@ void sys_sigrelease(int sig) #endif /* !SIG_SIGNAL */ #endif /* !SIG_SIGSET */ +#if defined(__ANDROID__) +int __system_properties_fd(void); +#endif /* __ANDROID__ */ + +#if defined(__ANDROID__) +#define SHELL "/system/bin/sh" +#else +#define SHELL "/bin/sh" +#endif /* __ANDROID__ */ + + int main(int argc, char *argv[]) { @@ -89,8 +100,23 @@ main(int argc, char *argv[]) if (sscanf(argv[CS_ARGV_FD_CR_IX], "%d:%d", &from, &to) != 2) return 1; + +#if defined(__ANDROID__) + for (i = from; i <= to; i++) { + if (i!=__system_properties_fd) + (void) close(i); + } +#else for (i = from; i <= to; i++) (void) close(i); +#endif /* __ANDROID__ */ + +#if defined(HAVE_CLOSEFROM) + closefrom(from); +#else + for (i = from; i <= to; i++) + (void) close(i); +#endif if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0') && chdir(argv[CS_ARGV_WD_IX]) < 0) @@ -116,7 +142,25 @@ main(int argc, char *argv[]) execv(argv[CS_ARGV_NO_OF_ARGS],&(argv[CS_ARGV_NO_OF_ARGS + 1])); } } else { - execl("/bin/sh", "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL); + execl(SHELL, "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL); } return 1; } + + + +#if defined(__ANDROID__) +int __system_properties_fd(void) +{ + int s, fd; + char *env; + + env = getenv("ANDROID_PROPERTY_WORKSPACE"); + if (!env) { + return -1; + } + fd = atoi(env); + return fd; +} +#endif /* __ANDROID__ */ + diff --git a/erts/emulator/sys/unix/erl_unix_sys_ddll.c b/erts/emulator/sys/unix/erl_unix_sys_ddll.c index 8760b58839..2659d623c7 100644 --- a/erts/emulator/sys/unix/erl_unix_sys_ddll.c +++ b/erts/emulator/sys/unix/erl_unix_sys_ddll.c @@ -123,6 +123,7 @@ int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* e int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) { +#if defined(HAVE_DLOPEN) int ret = ERL_DE_NO_ERROR; char *str; dlerror(); @@ -148,6 +149,9 @@ int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) ret = ERL_DE_DYNAMIC_ERROR_OFFSET - find_errcode(str, err); } return ret; +#else + return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; +#endif } /* diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 865cb50a56..c3d7440409 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -149,6 +149,13 @@ extern void erl_crash_dump(char* file, int line, char* fmt, ...); #define DIR_SEPARATOR_CHAR '/' +#if defined(__ANDROID__) +#define SHELL "/system/bin/sh" +#else +#define SHELL "/bin/sh" +#endif /* __ANDROID__ */ + + #if defined(DEBUG) #define ERL_BUILD_TYPE_MARKER ".debug" #elif defined(PURIFY) @@ -1596,7 +1603,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op } } } else { - execle("/bin/sh", "sh", "-c", cmd_line, (char *) NULL, new_environ); + execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ); } child_error: _exit(1); @@ -1717,7 +1724,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op fcntl(i, F_SETFD, 1); qnx_spawn_options.flags = _SPAWN_SETSID; - if ((pid = spawnl(P_NOWAIT, "/bin/sh", "/bin/sh", "-c", cmd_line, + if ((pid = spawnl(P_NOWAIT, SHELL, SHELL, "-c", cmd_line, (char *) 0)) < 0) { erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); reset_qnx_spawn(); diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index 8015e8f378..a78dbf64af 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -60,16 +60,18 @@ #include <windows.h> #undef WIN32_LEAN_AND_MEAN -/* - * Define MAXPATHLEN in terms of MAXPATH if available. - */ - -#ifndef MAXPATH -#define MAXPATH MAX_PATH -#endif /* MAXPATH */ #ifndef MAXPATHLEN -#define MAXPATHLEN MAXPATH +#define MAXPATHLEN 4096 +/* + erts-6.0 (OTP 17.0): + We now accept windows paths longer than 260 (MAX_PATH) by conversion to + UNC path format. In order to also return long paths from the driver we + increased MAXPATHLEN from 260 to larger (but arbitrary) value 4096. + It would of course be nicer to instead dynamically allocate large enough + tmp buffers when efile_drv needs to return really long paths, and do that + for unix as well. + */ #endif /* MAXPATHLEN */ /* diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 5d5c3a1c3c..1678d537d1 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -52,7 +52,7 @@ static int epmd_main(int, char **, int); int epmd_dbg(int level,int port) /* Utility to debug epmd... */ { - char* argv[MAX_DEBUG+2]; + char* argv[MAX_DEBUG+4]; char ibuff[100]; int argc = 0; diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in index 5c2cd8aded..cfd36af962 100644 --- a/erts/etc/common/Makefile.in +++ b/erts/etc/common/Makefile.in @@ -66,7 +66,9 @@ LIBS = @LIBS@ LDFLAGS = @LDFLAGS@ # For clock_gettime in heart +ifneq ($(TARGET),arm-unknown-linux-androideabi) RTLIBS = @LIBRT@ +endif ifeq ($(TARGET),win32) ifeq ($(TYPE),debug) diff --git a/erts/lib_src/pthread/ethread.c b/erts/lib_src/pthread/ethread.c index 7f27b5f29c..79784c5b84 100644 --- a/erts/lib_src/pthread/ethread.c +++ b/erts/lib_src/pthread/ethread.c @@ -541,7 +541,11 @@ int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset) return EINVAL; } #endif - return pthread_sigmask(how, set, oset); +#if defined(__ANDROID__) + return sigprocmask(how, set, oset); +#else + return pthread_sigmask(how, set, oset); +#endif } int ethr_sigwait(const sigset_t *set, int *sig) diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 4707e517b4..44b050e59d 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1125,7 +1125,22 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), _ = open_output_file(File), - gen_hrlhead(Module). + gen_hrlhead(Module), + Protector = hrl_protector(OutFile), + emit(["-ifndef(",Protector,").\n", + "-define(",Protector,", true).\n" + "\n"]). + +hrl_protector(OutFile) -> + BaseName = filename:basename(OutFile), + P = "_" ++ string:to_upper(BaseName) ++ "_HRL_", + [if + $A =< C, C =< $Z -> C; + $a =< C, C =< $a -> C; + $0 =< C, C =< $9 -> C; + true -> $_ + end || C <- P]. + %% EMIT functions ************************ %% *************************************** @@ -1232,6 +1247,8 @@ pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> 0 -> 0; Y -> + Protector = hrl_protector(get(outfile)), + emit(["-endif. %% ",Protector,"\n"]), close_output_file(), asn1ct:verbose("--~p--~n", [{generated,lists:concat([get(outfile),".hrl"])}], diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 1b7b0226cc..cec94a49fd 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -447,7 +447,6 @@ message_to_string({opaque_size, [SizeType, Size]}) -> message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}) -> io_lib:format("The call ~s:~s~s breaks the opaqueness of the term ~s :: ~s\n", [M, F, Args, Culprit, OpaqueType]); - %%----- Warnings for concurrency errors -------------------- message_to_string({race_condition, [M, F, Args, Reason]}) -> io_lib:format("The call ~w:~w~s ~s\n", [M, F, Args, Reason]); @@ -564,4 +563,4 @@ form_position_string(ArgNs) -> ordinal(1) -> "1st"; ordinal(2) -> "2nd"; ordinal(3) -> "3rd"; -ordinal(N) when is_integer(N) -> io_lib:format("~wth",[N]). +ordinal(N) when is_integer(N) -> io_lib:format("~wth", [N]). diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index 6cb4af6a46..9a25f86512 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -89,12 +89,6 @@ -type dial_error() :: any(). %% XXX: underspecified %%-------------------------------------------------------------------- -%% THIS TYPE SHOULD ONE DAY DISAPPEAR -- IT DOES NOT BELONG HERE -%%-------------------------------------------------------------------- - --type ordset(T) :: [T] . %% XXX: temporarily - -%%-------------------------------------------------------------------- %% Basic types used either in the record definitions below or in other %% parts of the application %%-------------------------------------------------------------------- @@ -144,7 +138,7 @@ init_plts = [] :: [file:filename()], include_dirs = [] :: [file:filename()], output_plt = none :: 'none' | file:filename(), - legal_warnings = ordsets:new() :: ordset(dial_warn_tag()), + legal_warnings = ordsets:new() :: ordsets:ordset(dial_warn_tag()), report_mode = normal :: rep_mode(), erlang_mode = false :: boolean(), use_contracts = true :: boolean(), @@ -168,4 +162,4 @@ dialyzer_timing:end_stamp(Server), Var end). --define(timing(Server, Msg, Expr),?timing(Server, Msg, _T, Expr)). +-define(timing(Server, Msg, Expr), ?timing(Server, Msg, _T, Expr)). diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl index f1ac41ff04..e3ece144c9 100644 --- a/lib/dialyzer/src/dialyzer_dep.erl +++ b/lib/dialyzer/src/dialyzer_dep.erl @@ -55,11 +55,11 @@ %% %% Letrecs = a dict mapping var labels to their recursive definition. %% top-level letrecs are not included as they are handled -%% separatedly. +%% separately. %% -spec analyze(cerl:c_module()) -> - {dict:dict(), ordset('external' | label()), dict:dict(), dict:dict()}. + {dict:dict(), ordsets:ordset('external' | label()), dict:dict(), dict:dict()}. analyze(Tree) -> %% io:format("Handling ~w\n", [cerl:atom_val(cerl:module_name(Tree))]), diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 08f31c1e13..7070fa240d 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -61,7 +61,7 @@ init_plt :: dialyzer_plt:plt(), dir_entry :: wx:wx_object(), file_box :: wx:wx_object(), - files_to_analyze :: ordset(string()), + files_to_analyze :: ordsets:ordset(string()), gui :: wx:wx_object(), log :: wx:wx_object(), menu :: menu(), diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 48fcde8014..b1f849b16f 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -85,6 +85,12 @@ -type race_tag() :: 'whereis_register' | 'whereis_unregister' | 'ets_lookup_insert' | 'mnesia_dirty_read_write'. +%% The following type is similar to the dial_warning() type but has a +%% tag which is local to this module and is not propagated to outside +-type dial_race_warning() :: {race_warn_tag(), file_line(), {atom(), [term()]}}. +-type race_warn_tag() :: ?WARN_WHEREIS_REGISTER | ?WARN_WHEREIS_UNREGISTER + | ?WARN_ETS_LOOKUP_INSERT | ?WARN_MNESIA_DIRTY_READ_WRITE. + -record(beg_clause, {arg :: var_to_map1(), pats :: var_to_map1(), guard :: cerl:cerl()}). @@ -103,7 +109,7 @@ args :: args(), arg_types :: [erl_types:erl_type()], vars :: [core_vars()], - state :: _, %% XXX: recursive + state :: dialyzer_dataflow:state(), file_line :: file_line(), var_map :: dict:dict()}). -record(fun_call, {caller :: dialyzer_callgraph:mfa_or_funlbl(), @@ -141,7 +147,7 @@ race_tags = [] :: [#race_fun{}], %% true for fun types and warning mode race_analysis = false :: boolean(), - race_warnings = [] :: [dial_warning()]}). + race_warnings = [] :: [dial_race_warning()]}). %%% =========================================================================== %%% @@ -1763,7 +1769,7 @@ ets_list_args(MaybeList) -> catch _:_ -> [?no_label] end; false -> [ets_tuple_args(MaybeList)] - end. + end. ets_list_argtypes(ListStr) -> ListStr1 = string:strip(ListStr, left, $[), diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl new file mode 100644 index 0000000000..70059f73b6 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl @@ -0,0 +1,12 @@ +-module(maps_redef). + +-export([t/0]). + +%% OK in Erlang/OTP 17, at least. + +-type map() :: atom(). % redefine built-in type + +-spec t() -> map(). + +t() -> + a. % OK diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 3175d1bdfd..2e8418d61e 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -1166,7 +1166,11 @@ static unsigned int gen_challenge(void) uname(&s.name); s.cpu = clock(); s.pid = getpid(); +#ifndef __ANDROID__ s.hid = gethostid(); +#else + s.hid = 0; +#endif s.uid = getuid(); s.gid = getgid(); diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 74dcba61a7..cffcac801c 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -642,7 +642,7 @@ struct hostent *ei_gethostbyname_r(const char *name, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); #else -#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) +#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile index a9e24f4d17..46cbc33ae2 100644 --- a/lib/hipe/Makefile +++ b/lib/hipe/Makefile @@ -22,7 +22,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ifdef HIPE_ENABLED -HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools +HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools llvm else HIPE_SUBDIRS = endif diff --git a/lib/hipe/arm/hipe_arm_assemble.erl b/lib/hipe/arm/hipe_arm_assemble.erl index 2af786994e..e9de96a927 100644 --- a/lib/hipe/arm/hipe_arm_assemble.erl +++ b/lib/hipe/arm/hipe_arm_assemble.erl @@ -44,8 +44,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -320,7 +320,7 @@ do_pseudo_li(I, MFA, ConstMap, Address, PrevImms, PendImms) -> Atom when is_atom(Atom) -> {load_atom, Atom}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -518,37 +518,6 @@ fix_pc_refs(I, InsnAddress, FunAddress, LabelMap) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -594,17 +563,6 @@ fill_spaces(N) when N > 0 -> fill_spaces(0) -> []. -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index aa69b57fa2..5938d94e65 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -502,9 +502,9 @@ t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; t_contains_opaque(?int_set(_Set), _Opaques) -> false; t_contains_opaque(?list(Type, Tail, _), Opaques) -> t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); -t_contains_opaque(?map(Pairs), Opaques) -> - list_contains_opaque([V||{_,V}<-Pairs], Opaques) orelse - list_contains_opaque([K||{K,_}<-Pairs], Opaques); +t_contains_opaque(?map(_) = Map, Opaques) -> + list_contains_opaque(map_values(Map), Opaques) orelse + list_contains_opaque(map_keys(Map), Opaques); t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; t_contains_opaque(?nil, _Opaques) -> false; t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; @@ -2093,6 +2093,8 @@ t_has_var(?tuple(Elements, _, _)) -> t_has_var_list(Elements); t_has_var(?tuple_set(_) = T) -> t_has_var_list(t_tuple_subtypes(T)); +t_has_var(?map(_)= Map) -> + t_has_var_list(map_keys(Map)) orelse t_has_var_list(map_values(Map)); t_has_var(?opaque(Set)) -> %% Assume variables in 'args' are also present i 'struct' t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]); @@ -2120,21 +2122,28 @@ t_collect_vars(?function(Domain, Range), Acc) -> t_collect_vars(?list(Contents, Termination, _), Acc) -> ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, [])); t_collect_vars(?product(Types), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple(?any, ?any, ?any), Acc) -> Acc; t_collect_vars(?tuple(Types, _, _), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple_set(_) = TS, Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, - t_tuple_subtypes(TS)); + t_collect_vars_list(t_tuple_subtypes(TS), Acc); +t_collect_vars(?map(_) = Map, Acc0) -> + Acc = t_collect_vars_list(map_keys(Map), Acc0), + t_collect_vars_list(map_values(Map), Acc); t_collect_vars(?opaque(Set), Acc) -> %% Assume variables in 'args' are also present i 'struct' - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, - [O#opaque.struct || O <- set_to_list(Set)]); + t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc); +t_collect_vars(?union(List), Acc) -> + t_collect_vars_list(List, Acc); t_collect_vars(_, Acc) -> Acc. +t_collect_vars_list([T|Ts], Acc0) -> + Acc = t_collect_vars(T, Acc0), + t_collect_vars_list(Ts, Acc); +t_collect_vars_list([], Acc) -> Acc. %%============================================================================= %% @@ -3081,6 +3090,9 @@ t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> t_tuple([t_subst_dict(E, Dict) || E <- Elements]); t_subst_dict(?tuple_set(_) = TS, Dict) -> t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); +t_subst_dict(?map(Pairs), Dict) -> + ?map([{t_subst_dict(K, Dict), t_subst_dict(V, Dict)} || + {K, V} <- Pairs]); t_subst_dict(?opaque(Es), Dict) -> List = [Opaque#opaque{args = [t_subst_dict(Arg, Dict) || Arg <- Args], struct = t_subst_dict(S, Dict)} || @@ -3130,6 +3142,9 @@ t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); t_subst_aux(?tuple_set(_) = TS, VarMap) -> t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(?map(Pairs), VarMap) -> + ?map([{t_subst_aux(K, VarMap), t_subst_aux(V, VarMap)} || + {K, V} <- Pairs]); t_subst_aux(?opaque(Es), VarMap) -> List = [Opaque#opaque{args = [t_subst_aux(Arg, VarMap) || Arg <- Args], struct = t_subst_aux(S, VarMap)} || @@ -3705,7 +3720,7 @@ t_unopaque(T) -> t_unopaque(?opaque(_) = T, Opaques) -> case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of true -> t_unopaque(t_opaque_structure(T), Opaques); - false -> T % XXX: needs revision for parametric opaque data types + false -> T end; t_unopaque(?list(ElemT, Termination, Sz), Opaques) -> ?list(t_unopaque(ElemT, Opaques), t_unopaque(Termination, Opaques), Sz); @@ -3725,11 +3740,12 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), + UMap = t_unopaque(Map, Opaques), {OF,UO} = case t_unopaque(O, Opaques) of ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,Map])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,UMap])|UO]); t_unopaque(T, _) -> T. @@ -4236,8 +4252,8 @@ t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_list(T), R}; -t_from_form({type, _L, map, _}, _TypeNames, _RecDict, _VarDict) -> - {t_map([]), []}; +t_from_form({type, _L, map, _}, TypeNames, RecDict, VarDict) -> + builtin_type(map, t_map([]), TypeNames, RecDict, VarDict); t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> {t_mfa(), []}; t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4700,6 +4716,12 @@ is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true; is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true; is_same_type_name2(_, _, _, _, _, _) -> false. +map_keys(?map(Pairs)) -> + [K || {K, _} <- Pairs]. + +map_values(?map(Pairs)) -> + [V || {_, V} <- Pairs]. + %% ----------------------------------- %% Set %% diff --git a/lib/hipe/llvm/Makefile b/lib/hipe/llvm/Makefile new file mode 100644 index 0000000000..92f378924a --- /dev/null +++ b/lib/hipe/llvm/Makefile @@ -0,0 +1,109 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2014. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +ifndef EBIN +EBIN = ../ebin +endif + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(HIPE_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +ifdef HIPE_ENABLED +HIPE_MODULES = hipe_rtl_to_llvm \ + hipe_llvm \ + elf_format \ + hipe_llvm_main \ + hipe_llvm_merge \ + hipe_llvm_liveness +else +HIPE_MODULES = +endif + +MODULES = $(HIPE_MODULES) + +HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl \ + hipe_llvm_arch.hrl +ERL_FILES= $(MODULES:%=%.erl) +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# APP_FILE= +# App_SRC= $(APP_FILE).src +# APP_TARGET= $(EBIN)/$(APP_FILE) +# +# APPUP_FILE= +# APPUP_SRC= $(APPUP_FILE).src +# APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS: Please keep +inline below +# ---------------------------------------------------- + +include ../native.mk + +ERL_COMPILE_FLAGS += +inline #+warn_missing_spec + +# if in 32 bit backend define BIT32 symbol +ARCH = $(shell echo $(TARGET) | sed 's/^\(x86_64\)-.*/64bit/') +ifneq ($(ARCH), 64bit) +ERL_COMPILE_FLAGS += -DBIT32 +endif + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +docs: + +clean: + rm -f $(TARGET_FILES) + rm -f core erl_crash.dump + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/llvm + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/llvm + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: diff --git a/lib/hipe/llvm/elf32_format.hrl b/lib/hipe/llvm/elf32_format.hrl new file mode 100644 index 0000000000..af1d95bf5b --- /dev/null +++ b/lib/hipe/llvm/elf32_format.hrl @@ -0,0 +1,59 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-32 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://www.sco.com/developers/gabi/latest/contents.html]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-32 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 4). +-define(ELF_OFF_SIZE, 4). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, ?ELF_WORD_SIZE). % for compatibility +-define(ELF_SXWORD_SIZE, ?ELF_WORD_SIZE). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-32 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary (needed because +%% of the different offsets in 32 and 64 bit formats). +-define(ST_NAME_OFFSET, 0). +-define(ST_VALUE_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). +-define(ST_INFO_OFFSET, (?ST_SIZE_OFFSET + ?ST_SIZE_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 8) ). +-define(ELF_R_TYPE(I), (I band 16#ff) ). +-define(ELF_R_INFO(S, T), ((S bsl 8) + (T band 16#ff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf64_format.hrl b/lib/hipe/llvm/elf64_format.hrl new file mode 100644 index 0000000000..794746ffdc --- /dev/null +++ b/lib/hipe/llvm/elf64_format.hrl @@ -0,0 +1,58 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-64 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://downloads.openwatcom.org/ftp/devel/docs/elf-64-gen.pdf]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-64 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 8). +-define(ELF_OFF_SIZE, 8). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, 8). +-define(ELF_SXWORD_SIZE, 8). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-64 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary +-define(ST_NAME_OFFSET, 0). +-define(ST_INFO_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). +-define(ST_VALUE_OFFSET, (?ST_SHNDX_OFFSET + ?ST_SHNDX_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 32) ). +-define(ELF_R_TYPE(I), (I band 16#ffffffff) ). +-define(ELF_R_INFO(S, T), ((S bsl 32) + (T band 16#ffffffff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf_format.erl b/lib/hipe/llvm/elf_format.erl new file mode 100644 index 0000000000..260da9b5e6 --- /dev/null +++ b/lib/hipe/llvm/elf_format.erl @@ -0,0 +1,790 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]>, +%%% Kostis Sagonas <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This module contains functions for extracting various pieces of +%%% information from an ELF formated Object file. To fully understand +%%% the ELF format and the use of these functions please read +%%% "[http://www.linuxjournal.com/article/1060?page=0,0]" carefully. + +-module(elf_format). + +-export([get_tab_entries/1, + %% Relocations + get_rodata_relocs/1, + get_text_relocs/1, + extract_rela/2, + get_rela_addends/1, + %% Note + extract_note/2, + %% Executable code + extract_text/1, + %% GCC Exception Table + get_exn_handlers/1, + %% Misc. + set_architecture_flag/1, + is64bit/0 + ]). + +-include("elf_format.hrl"). + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-type elf() :: binary(). + +-type lp() :: non_neg_integer(). % landing pad +-type num() :: non_neg_integer(). +-type index() :: non_neg_integer(). +-type offset() :: non_neg_integer(). +-type size() :: non_neg_integer(). +-type start() :: non_neg_integer(). + +-type info() :: index(). +-type nameoff() :: offset(). +-type valueoff() :: offset(). + +-type name() :: string(). +-type name_size() :: {name(), size()}. +-type name_sizes() :: [name_size()]. + +%%------------------------------------------------------------------------------ +%% Abstract Data Types and Accessors for ELF Structures. +%%------------------------------------------------------------------------------ + +%% File header +-record(elf_ehdr, {ident, % ELF identification + type, % Object file type + machine, % Machine Type + version, % Object file version + entry, % Entry point address + phoff, % Program header offset + shoff :: offset(), % Section header offset + flags, % Processor-specific flags + ehsize :: size(), % ELF header size + phentsize :: size(), % Size of program header entry + phnum :: num(), % Number of program header entries + shentsize :: size(), % Size of section header entry + shnum :: num(), % Number of section header entries + shstrndx :: index() % Section name string table index + }). +-type elf_ehdr() :: #elf_ehdr{}. + +-record(elf_ehdr_ident, {class, % File class + data, % Data encoding + version, % File version + osabi, % OS/ABI identification + abiversion, % ABI version + pad, % Start of padding bytes + nident % Size of e_ident[] + }). +%% -type elf_ehdr_ident() :: #elf_ehdr_ident{}. + +%% Section header entries +-record(elf_shdr, {name, % Section name + type, % Section type + flags, % Section attributes + addr, % Virtual address in memory + offset :: offset(), % Offset in file + size :: size(), % Size of section + link, % Link to other section + info, % Miscellaneous information + addralign, % Address align boundary + entsize % Size of entries, if section has table + }). +%% -type elf_shdr() :: #elf_shdr{}. + +%% Symbol table entries +-record(elf_sym, {name :: nameoff(), % Symbol name + info, % Type and Binding attributes + other, % Reserved + shndx, % Section table index + value :: valueoff(), % Symbol value + size :: size() % Size of object + }). +-type elf_sym() :: #elf_sym{}. + +%% Relocations +-record(elf_rel, {r_offset :: offset(), % Address of reference + r_info :: info() % Symbol index and type of relocation + }). +-type elf_rel() :: #elf_rel{}. + +-record(elf_rela, {r_offset :: offset(), % Address of reference + r_info :: info(), % Symbol index and type of relocation + r_addend :: offset() % Constant part of expression + }). +-type elf_rela() :: #elf_rela{}. + +%% %% Program header table +%% -record(elf_phdr, {type, % Type of segment +%% flags, % Segment attributes +%% offset, % Offset in file +%% vaddr, % Virtual address in memory +%% paddr, % Reserved +%% filesz, % Size of segment in file +%% memsz, % Size of segment in memory +%% align % Alignment of segment +%% }). + +%% %% GCC exception table +%% -record(elf_gccexntab, {lpbenc, % Landing pad base encoding +%% lpbase, % Landing pad base +%% ttenc, % Type table encoding +%% ttoff, % Type table offset +%% csenc, % Call-site table encoding +%% cstabsize, % Call-site table size +%% cstab :: cstab() % Call-site table +%% }). +%% -type elf_gccexntab() :: #elf_gccexntab{}. + +-record(elf_gccexntab_callsite, {start :: start(), % Call-site start + size :: size(), % Call-site size + lp :: lp(), % Call-site landing pad + % (exception handler) + onaction % On action (e.g. cleanup) + }). +%% -type elf_gccexntab_callsite() :: #elf_gccexntab_callsite{}. + +%%------------------------------------------------------------------------------ +%% Accessor Functions +%%------------------------------------------------------------------------------ + +%% File header +%% -spec mk_ehdr(...) -> elf_ehrd(). +mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, Ehsize, + Phentsize, Phnum, Shentsize, Shnum, Shstrndx) -> + #elf_ehdr{ident = Ident, type = Type, machine = Machine, version = Version, + entry = Entry, phoff = Phoff, shoff = Shoff, flags = Flags, + ehsize = Ehsize, phentsize = Phentsize, phnum = Phnum, + shentsize = Shentsize, shnum = Shnum, shstrndx = Shstrndx}. + +%% -spec ehdr_shoff(elf_ehdr()) -> offset(). +%% ehdr_shoff(#elf_ehdr{shoff = Offset}) -> Offset. +%% +%% -spec ehdr_shentsize(elf_ehdr()) -> size(). +%% ehdr_shentsize(#elf_ehdr{shentsize = Size}) -> Size. +%% +%% -spec ehdr_shnum(elf_ehdr()) -> num(). +%% ehdr_shnum(#elf_ehdr{shnum = Num}) -> Num. +%% +%% -spec ehdr_shstrndx(elf_ehdr()) -> index(). +%% ehdr_shstrndx(#elf_ehdr{shstrndx = Index}) -> Index. + + +%%-spec mk_ehdr_ident(...) -> elf_ehdr_ident(). +mk_ehdr_ident(Class, Data, Version, OsABI, AbiVersion, Pad, Nident) -> + #elf_ehdr_ident{class = Class, data = Data, version = Version, osabi = OsABI, + abiversion = AbiVersion, pad = Pad, nident = Nident}. + +%%%------------------------- +%%% Section header entries +%%%------------------------- +mk_shdr(Name, Type, Flags, Addr, Offset, Size, Link, Info, AddrAlign, EntSize) -> + #elf_shdr{name = Name, type = Type, flags = Flags, addr = Addr, + offset = Offset, size = Size, link = Link, info = Info, + addralign = AddrAlign, entsize = EntSize}. + +%% -spec shdr_offset(elf_shdr()) -> offset(). +%% shdr_offset(#elf_shdr{offset = Offset}) -> Offset. +%% +%% -spec shdr_size(elf_shdr()) -> size(). +%% shdr_size(#elf_shdr{size = Size}) -> Size. + +%%%------------------------- +%%% Symbol Table Entries +%%%------------------------- +mk_sym(Name, Info, Other, Shndx, Value, Size) -> + #elf_sym{name = Name, info = Info, other = Other, + shndx = Shndx, value = Value, size = Size}. + +-spec sym_name(elf_sym()) -> nameoff(). +sym_name(#elf_sym{name = Name}) -> Name. + +%% -spec sym_value(elf_sym()) -> valueoff(). +%% sym_value(#elf_sym{value = Value}) -> Value. +%% +%% -spec sym_size(elf_sym()) -> size(). +%% sym_size(#elf_sym{size = Size}) -> Size. + +%%%------------------------- +%%% Relocations +%%%------------------------- +-spec mk_rel(offset(), info()) -> elf_rel(). +mk_rel(Offset, Info) -> + #elf_rel{r_offset = Offset, r_info = Info}. + +%% The following two functions capitalize on the fact that the two kinds of +%% relocation records (for 32- and 64-bit architectures have similar structure. + +-spec r_offset(elf_rel() | elf_rela()) -> offset(). +r_offset(#elf_rel{r_offset = Offset}) -> Offset; +r_offset(#elf_rela{r_offset = Offset}) -> Offset. + +-spec r_info(elf_rel() | elf_rela()) -> info(). +r_info(#elf_rel{r_info = Info}) -> Info; +r_info(#elf_rela{r_info = Info}) -> Info. + +-spec mk_rela(offset(), info(), offset()) -> elf_rela(). +mk_rela(Offset, Info, Addend) -> + #elf_rela{r_offset = Offset, r_info = Info, r_addend = Addend}. + +-spec rela_addend(elf_rela()) -> offset(). +rela_addend(#elf_rela{r_addend = Addend}) -> Addend. + +%% %%%------------------------- +%% %%% GCC exception table +%% %%%------------------------- +%% -type cstab() :: [elf_gccexntab_callsite()]. +%% +%% mk_gccexntab(LPbenc, LPbase, TTenc, TToff, CSenc, CStabsize, CStab) -> +%% #elf_gccexntab{lpbenc = LPbenc, lpbase = LPbase, ttenc = TTenc, +%% ttoff = TToff, csenc = CSenc, cstabsize = CStabsize, +%% cstab = CStab}. +%% +%% -spec gccexntab_cstab(elf_gccexntab()) -> cstab(). +%% gccexntab_cstab(#elf_gccexntab{cstab = CSTab}) -> CSTab. + +mk_gccexntab_callsite(Start, Size, LP, Action) -> + #elf_gccexntab_callsite{start = Start, size=Size, lp=LP, onaction=Action}. + +%% -spec gccexntab_callsite_start(elf_gccexntab_callsite()) -> start(). +%% gccexntab_callsite_start(#elf_gccexntab_callsite{start = Start}) -> Start. +%% +%% -spec gccexntab_callsite_size(elf_gccexntab_callsite()) -> size(). +%% gccexntab_callsite_size(#elf_gccexntab_callsite{size = Size}) -> Size. +%% +%% -spec gccexntab_callsite_lp(elf_gccexntab_callsite()) -> lp(). +%% gccexntab_callsite_lp(#elf_gccexntab_callsite{lp = LP}) -> LP. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate the ELF File Header +%%------------------------------------------------------------------------------ + +%% @doc Extracts the File Header from an ELF formatted object file. Also sets +%% the ELF class variable in the process dictionary (used by many functions +%% in this and hipe_llvm_main modules). +-spec extract_header(elf()) -> elf_ehdr(). +extract_header(Elf) -> + Ehdr_bin = get_binary_segment(Elf, 0, ?ELF_EHDR_SIZE), + << %% Structural pattern matching on fields. + Ident_bin:?E_IDENT_SIZE/binary, + Type:?bits(?E_TYPE_SIZE)/integer-little, + Machine:?bits(?E_MACHINE_SIZE)/integer-little, + Version:?bits(?E_VERSION_SIZE)/integer-little, + Entry:?bits(?E_ENTRY_SIZE)/integer-little, + Phoff:?bits(?E_PHOFF_SIZE)/integer-little, + Shoff:?bits(?E_SHOFF_SIZE)/integer-little, + Flags:?bits(?E_FLAGS_SIZE)/integer-little, + Ehsize:?bits(?E_EHSIZE_SIZE)/integer-little, + Phentsize:?bits(?E_PHENTSIZE_SIZE)/integer-little, + Phnum:?bits(?E_PHNUM_SIZE)/integer-little, + Shentsize:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shnum:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shstrndx:?bits(?E_SHSTRNDX_SIZE)/integer-little + >> = Ehdr_bin, + <<16#7f, $E, $L, $F, Class, Data, Version, Osabi, Abiversion, + Pad:6/binary, Nident + >> = Ident_bin, + Ident = mk_ehdr_ident(Class, Data, Version, Osabi, + Abiversion, Pad, Nident), + mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, + Ehsize, Phentsize, Phnum, Shentsize, Shnum, Shstrndx). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Section Header Entries +%%------------------------------------------------------------------------------ + +%% @doc Extracts the Section Header Table from an ELF formated Object File. +extract_shdrtab(Elf) -> + %% Extract File Header to get info about Section Header Offset (in bytes), + %% Entry Size (in bytes) and Number of entries + #elf_ehdr{shoff = ShOff, shentsize = ShEntsize, shnum = ShNum} = + extract_header(Elf), + %% Get actual Section header table (binary) + ShdrBin = get_binary_segment(Elf, ShOff, ShNum * ShEntsize), + get_shdrtab_entries(ShdrBin, []). + +get_shdrtab_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_shdrtab_entries(ShdrBin, Acc) -> + <<%% Structural pattern matching on fields. + Name:?bits(?SH_NAME_SIZE)/integer-little, + Type:?bits(?SH_TYPE_SIZE)/integer-little, + Flags:?bits(?SH_FLAGS_SIZE)/integer-little, + Addr:?bits(?SH_ADDR_SIZE)/integer-little, + Offset:?bits(?SH_OFFSET_SIZE)/integer-little, + Size:?bits(?SH_SIZE_SIZE)/integer-little, + Link:?bits(?SH_LINK_SIZE)/integer-little, + Info:?bits(?SH_INFO_SIZE)/integer-little, + Addralign:?bits(?SH_ADDRALIGN_SIZE)/integer-little, + Entsize:?bits(?SH_ENTSIZE_SIZE)/integer-little, + MoreShdrE/binary + >> = ShdrBin, + ShdrE = mk_shdr(Name, Type, Flags, Addr, Offset, + Size, Link, Info, Addralign, Entsize), + get_shdrtab_entries(MoreShdrE, [ShdrE | Acc]). + +%% @doc Extracts a specific Entry of a Section Header Table. This function +%% takes as argument the Section Header Table (`SHdrTab') and the entry's +%% serial number (`EntryNum') and returns the entry (`shdr'). +get_shdrtab_entry(SHdrTab, EntryNum) -> + lists:nth(EntryNum + 1, SHdrTab). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Section Header String Table +%%------------------------------------------------------------------------------ + +%% @doc Extracts the Section Header String Table. This section is not a known +%% ELF Object File section. It is just a "hidden" table storing the +%% names of all sections that exist in current object file. +-spec extract_shstrtab(elf()) -> [name()]. +extract_shstrtab(Elf) -> + %% Extract Section Name String Table Index + #elf_ehdr{shstrndx = ShStrNdx} = extract_header(Elf), + ShHdrTab = extract_shdrtab(Elf), + %% Extract Section header entry and get actual Section-header String Table + #elf_shdr{offset = ShStrOffset, size = ShStrSize} = + get_shdrtab_entry(ShHdrTab, ShStrNdx), + case get_binary_segment(Elf, ShStrOffset, ShStrSize) of + <<>> -> %% Segment empty + []; + ShStrTab -> %% Convert to string table + [Name || {Name, _Size} <- get_names(ShStrTab)] + end. + +%%------------------------------------------------------------------------------ + +-spec get_tab_entries(elf()) -> [{name(), valueoff(), size()}]. +get_tab_entries(Elf) -> + SymTab = extract_symtab(Elf), + Ts = [{Name, Value, Size div ?ELF_XWORD_SIZE} + || #elf_sym{name = Name, value = Value, size = Size} <- SymTab, + Name =/= 0], + {NameIndices, ValueOffs, Sizes} = lists:unzip3(Ts), + %% Find the names of the symbols. + %% Get string table entries ([{Name, Offset in strtab section}]). Keep only + %% relevant entries: + StrTab = extract_strtab(Elf), + Relevant = [get_strtab_entry(StrTab, Off) || Off <- NameIndices], + %% Zip back to {Name, ValueOff, Size} + lists:zip3(Relevant, ValueOffs, Sizes). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Symbol Table +%%------------------------------------------------------------------------------ + +%% @doc Function that extracts Symbol Table from an ELF Object file. +extract_symtab(Elf) -> + Symtab_bin = extract_segment_by_name(Elf, ?SYMTAB), + get_symtab_entries(Symtab_bin, []). + +get_symtab_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_symtab_entries(Symtab_bin, Acc) -> + <<SymE_bin:?ELF_SYM_SIZE/binary, MoreSymE/binary>> = Symtab_bin, + case is64bit() of + true -> + <<%% Structural pattern matching on fields. + Name:?bits(?ST_NAME_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little + >> = SymE_bin; + false -> + << %% Same fields in different order: + Name:?bits(?ST_NAME_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little + >> = SymE_bin + end, + SymE = mk_sym(Name, Info, Other, Shndx, Value, Size), + get_symtab_entries(MoreSymE, [SymE | Acc]). + +%% @doc Extracts a specific entry from the Symbol Table (as binary). +%% This function takes as arguments the Symbol Table (`SymTab') +%% and the entry's serial number and returns that entry (`sym'). +get_symtab_entry(SymTab, EntryNum) -> + lists:nth(EntryNum + 1, SymTab). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate String Table +%%------------------------------------------------------------------------------ + +%% @doc Extracts String Table from an ELF formated Object File. +-spec extract_strtab(elf()) -> [{string(), offset()}]. +extract_strtab(Elf) -> + Strtab_bin = extract_segment_by_name(Elf, ?STRTAB), + NamesSizes = get_names(Strtab_bin), + make_offsets(NamesSizes). + +%% @doc Returns the name of the symbol at the given offset. The string table +%% contains entries of the form {Name, Offset}. If no such offset exists +%% returns the empty string (`""'). +%% XXX: There might be a bug here because of the "compact" saving the ELF +%% format uses: e.g. only stores ".rela.text" for ".rela.text" and ".text". +get_strtab_entry(Strtab, Offset) -> + case lists:keyfind(Offset, 2, Strtab) of + {Name, Offset} -> Name; + false -> "" + end. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Relocations +%%------------------------------------------------------------------------------ + +%% @doc This function gets as argument an ELF binary file and returns a list +%% with all .rela.rodata labels (i.e. constants and literals in code) +%% or an empty list if no ".rela.rodata" section exists in code. +-spec get_rodata_relocs(elf()) -> [offset()]. +get_rodata_relocs(Elf) -> + case is64bit() of + true -> + %% Only care about the addends (== offsets): + get_rela_addends(extract_rela(Elf, ?RODATA)); + false -> + %% Find offsets hardcoded in ".rodata" entry + %%XXX: Treat all 0s as padding and skip them! + [SkipPadding || SkipPadding <- extract_rodata(Elf), SkipPadding =/= 0] + end. + +-spec get_rela_addends([elf_rela()]) -> [offset()]. +get_rela_addends(RelaEntries) -> + [rela_addend(E) || E <- RelaEntries]. + +%% @doc Extract a list of the form `[{SymbolName, Offset}]' with all relocatable +%% symbols and their offsets in the code from the ".text" section. +-spec get_text_relocs(elf()) -> [{name(), offset()}]. +get_text_relocs(Elf) -> + %% Only care about the symbol table index and the offset: + NameOffsetTemp = [{?ELF_R_SYM(r_info(E)), r_offset(E)} + || E <- extract_rela(Elf, ?TEXT)], + {NameIndices, ActualOffsets} = lists:unzip(NameOffsetTemp), + %% Find the names of the symbols: + %% + %% Get those symbol table entries that are related to Text relocs: + Symtab = extract_symtab(Elf), + SymtabEs = [get_symtab_entry(Symtab, Index) || Index <- NameIndices], + %XXX: not zero-indexed! + %% Symbol table entries contain the offset of the name of the symbol in + %% String Table: + SymtabEs2 = [sym_name(E) || E <- SymtabEs], %XXX: Do we need to sort SymtabE? + %% Get string table entries ([{Name, Offset in strtab section}]). Keep only + %% relevant entries: + Strtab = extract_strtab(Elf), + Relevant = [get_strtab_entry(Strtab, Off) || Off <- SymtabEs2], + %% Zip back with actual offsets: + lists:zip(Relevant, ActualOffsets). + +%% @doc Extract the Relocations segment for section `Name' (that is passed +%% as second argument) from an ELF formated Object file binary. +-spec extract_rela(elf(), name()) -> [elf_rel() | elf_rela()]. +extract_rela(Elf, Name) -> + SegName = + case is64bit() of + true -> ?RELA(Name); % ELF-64 uses ".rela" + false -> ?REL(Name) % ...while ELF-32 uses ".rel" + end, + Rela_bin = extract_segment_by_name(Elf, SegName), + get_rela_entries(Rela_bin, []). + +get_rela_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_rela_entries(Bin, Acc) -> + E = case is64bit() of + true -> + <<%% Structural pattern matching on fields of a Rela Entry. + Offset:?bits(?R_OFFSET_SIZE)/integer-little, + Info:?bits(?R_INFO_SIZE)/integer-little, + Addend:?bits(?R_ADDEND_SIZE)/integer-little, + Rest/binary + >> = Bin, + mk_rela(Offset, Info, Addend); + false -> + <<%% Structural pattern matching on fields of a Rel Entry. + Offset:?bits(?R_OFFSET_SIZE)/integer-little, + Info:?bits(?R_INFO_SIZE)/integer-little, + Rest/binary + >> = Bin, + mk_rel(Offset, Info) + end, + get_rela_entries(Rest, [E | Acc]). + +%% %% @doc Extract the `EntryNum' (serial number) Relocation Entry. +%% get_rela_entry(Rela, EntryNum) -> +%% lists:nth(EntryNum + 1, Rela). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Executable Code segment +%%------------------------------------------------------------------------------ + +%% @doc This function gets as arguments an ELF formated binary file and +%% returns the Executable Code (".text" segment) or an empty binary if it +%% is not found. +-spec extract_text(elf()) -> binary(). +extract_text(Elf) -> + extract_segment_by_name(Elf, ?TEXT). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Note Section +%%------------------------------------------------------------------------------ + +%% @doc Extract specific Note Section from an ELF Object file. The function +%% takes as first argument the object file (`Elf') and the `Name' of the +%% wanted Note Section (<b>without</b> the ".note" prefix!). It returns +%% the specified binary segment or an empty binary if no such section +%% exists. +-spec extract_note(elf(), string()) -> binary(). +extract_note(Elf, Name) -> + extract_segment_by_name(Elf, ?NOTE(Name)). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate GCC Exception Table segment +%%------------------------------------------------------------------------------ + +%% A description for the C++ exception table formats can be found at Exception +%% Handling Tables (http://www.codesourcery.com/cxx-abi/exceptions.pdf). + +%% A list with `{Start, End, HandlerOffset}' for all call sites in the code +-spec get_exn_handlers(elf()) -> [{start(), start(), lp()}]. +get_exn_handlers(Elf) -> + CallSites = extract_gccexntab_callsites(Elf), + [{Start, Start + Size, LP} + || #elf_gccexntab_callsite{start = Start, size = Size, lp = LP} <- CallSites]. + +%% @doc This function gets as argument an ELF binary file and returns +%% the table (list) of call sites which is stored in GCC +%% Exception Table (".gcc_except_table") section. +%% It returns an empty list if the Exception Table is not found. +%% XXX: Assumes there is *no* Action Record Table. +extract_gccexntab_callsites(Elf) -> + case extract_segment_by_name(Elf, ?GCC_EXN_TAB) of + <<>> -> + []; + ExnTab -> + %% First byte of LSDA is Landing Pad base encoding. + <<LBenc:8, More/binary>> = ExnTab, + %% Second byte is the Landing Pad base (if its encoding is not + %% DW_EH_PE_omit) (optional). + {_LPBase, LSDACont} = + case LBenc =:= ?DW_EH_PE_omit of + true -> % No landing pad base byte. (-1 denotes that) + {-1, More}; + false -> % Landing pad base. + <<Base:8, More2/binary>> = More, + {Base, More2} + end, + %% Next byte of LSDA is the encoding of the Type Table. + <<TTenc:8, More3/binary>> = LSDACont, + %% Next byte is the Types Table offset encoded in U-LEB128 (optional). + {_TTOff, LSDACont2} = + case TTenc =:= ?DW_EH_PE_omit of + true -> % There is no Types Table pointer. (-1 denotes that) + {-1, More3}; + false -> % The byte offset from this field to the start of the Types + % Table used for exception matching. + leb128_decode(More3) + end, + %% Next byte of LSDA is the encoding of the fields in the Call-site Table. + <<_CSenc:8, More4/binary>> = LSDACont2, + %% Sixth byte is the size (in bytes) of the Call-site Table encoded in + %% U-LEB128. + {_CSTabSize, CSTab} = leb128_decode(More4), + %% Extract all call site information + get_gccexntab_callsites(CSTab, []) + end. + +get_gccexntab_callsites(<<>>, Acc) -> + lists:reverse(Acc); +get_gccexntab_callsites(CSTab, Acc) -> + %% We are only interested in the Landing Pad of every entry. + <<Start:32/integer-little, Size:32/integer-little, + LP:32/integer-little, OnAction:8, More/binary + >> = CSTab, + GccCS = mk_gccexntab_callsite(Start, Size, LP, OnAction), + get_gccexntab_callsites(More, [GccCS | Acc]). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Read-only Data (.rodata) +%%------------------------------------------------------------------------------ +extract_rodata(Elf) -> + Rodata_bin = extract_segment_by_name(Elf, ?RODATA), + get_rodata_entries(Rodata_bin, []). + +get_rodata_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_rodata_entries(Rodata_bin, Acc) -> + <<Num:?bits(?ELF_ADDR_SIZE)/integer-little, More/binary>> = Rodata_bin, + get_rodata_entries(More, [Num | Acc]). + +%%------------------------------------------------------------------------------ +%% Helper functions +%%------------------------------------------------------------------------------ + +%% @doc Returns the binary segment starting at `Offset' with length `Size' +%% (bytes) from a binary file. If `Offset' is bigger than the byte size of +%% the binary, an empty binary (`<<>>') is returned. +-spec get_binary_segment(binary(), offset(), size()) -> binary(). +get_binary_segment(Bin, Offset, _Size) when Offset > byte_size(Bin) -> + <<>>; +get_binary_segment(Bin, Offset, Size) -> + <<_Hdr:Offset/binary, BinSeg:Size/binary, _More/binary>> = Bin, + BinSeg. + +%% @doc This function gets as arguments an ELF formated binary object and +%% a string with the segments' name and returns the specified segment or +%% an empty binary (`<<>>') if there exists no segment with that name. +%% There are handy macros defined in elf_format.hrl for all Standard +%% Section Names. +-spec extract_segment_by_name(elf(), string()) -> binary(). +extract_segment_by_name(Elf, SectionName) -> + %% Extract Section Header Table and Section Header String Table from binary + SHdrTable = extract_shdrtab(Elf), + Names = extract_shstrtab(Elf), + %% Zip to a list of (Name,ShdrE) + [_Zero | ShdrEs] = lists:keysort(2, SHdrTable), % Skip first entry (zeros). + L = lists:zip(Names, ShdrEs), + %% Find Section Header Table entry by name + case lists:keyfind(SectionName, 1, L) of + {SectionName, ShdrE} -> %% Note: Same name. + #elf_shdr{offset = Offset, size = Size} = ShdrE, + get_binary_segment(Elf, Offset, Size); + false -> %% Not found. + <<>> + end. + +%% @doc Extracts a list of strings with (zero-separated) names from a binary. +%% Returns tuples of `{Name, Size}'. +%% XXX: Skip trailing 0. +-spec get_names(<<_:8,_:_*8>>) -> name_sizes(). +get_names(<<0, Bin/binary>>) -> + NamesSizes = get_names(Bin, []), + fix_names(NamesSizes, []). + +get_names(<<>>, Acc) -> + lists:reverse(Acc); +get_names(Bin, Acc) -> + {Name, MoreNames} = bin_get_string(Bin), + get_names(MoreNames, [{Name, length(Name)} | Acc]). + +%% @doc Fix names: +%% e.g. If ".rela.text" exists, ".text" does not. Same goes for +%% ".rel.text". In that way, the Section Header String Table is more +%% compact. Add ".text" just *before* the corresponding rela-field, +%% etc. +-spec fix_names(name_sizes(), name_sizes()) -> name_sizes(). +fix_names([], Acc) -> + lists:reverse(Acc); +fix_names([{Name, Size}=T | Names], Acc) -> + case is64bit() of + true -> + case string:str(Name, ".rela") =:= 1 of + true -> %% Name starts with ".rela": + Section = string:substr(Name, 6), + fix_names(Names, [{Section, Size - 5} + | [T | Acc]]); % XXX: Is order ok? (".text" + % always before ".rela.text") + false -> %% Name does not start with ".rela": + fix_names(Names, [T | Acc]) + end; + false -> + case string:str(Name, ".rel") =:= 1 of + true -> %% Name starts with ".rel": + Section = string:substr(Name, 5), + fix_names(Names, [{Section, Size - 4} + | [T | Acc]]); % XXX: Is order ok? (".text" + % always before ".rela.text") + false -> %% Name does not start with ".rel": + fix_names(Names, [T | Acc]) + end + end. + + +%% @doc A function that byte-reverses a binary. This might be needed because of +%% little (fucking!) endianess. +-spec bin_reverse(binary()) -> binary(). +bin_reverse(Bin) when is_binary(Bin) -> + bin_reverse(Bin, <<>>). + +-spec bin_reverse(binary(), binary()) -> binary(). +bin_reverse(<<>>, Acc) -> + Acc; +bin_reverse(<<Head, More/binary>>, Acc) -> + bin_reverse(More, <<Head, Acc/binary>>). + +%% @doc A function that extracts a null-terminated string from a binary. It +%% returns the found string along with the rest of the binary. +-spec bin_get_string(binary()) -> {string(), binary()}. +bin_get_string(Bin) -> + bin_get_string(Bin, <<>>). + +bin_get_string(<<>>, BinAcc) -> + Bin = bin_reverse(BinAcc), % little endian! + {binary_to_list(Bin), <<>>}; +bin_get_string(<<0, MoreBin/binary>>, BinAcc) -> + Bin = bin_reverse(BinAcc), % little endian! + {binary_to_list(Bin), MoreBin}; +bin_get_string(<<Letter, Tail/binary>>, BinAcc) -> + bin_get_string(Tail, <<Letter, BinAcc/binary>>). + +%% @doc +make_offsets(NamesSizes) -> + {Names, Sizes} = lists:unzip(NamesSizes), + Offsets = make_offsets_from_sizes(Sizes, 1, []), + lists:zip(Names, Offsets). + +make_offsets_from_sizes([], _, Acc) -> + lists:reverse(Acc); +make_offsets_from_sizes([Size | Sizes], Cur, Acc) -> + make_offsets_from_sizes(Sizes, Size+Cur+1, [Cur | Acc]). % For the "."! + +%% @doc Little-Endian Base 128 (LEB128) Decoder +%% This function extracts the <b>first</b> LEB128-encoded integer in a +%% binary and returns that integer along with the remaining binary. This is +%% done because a LEB128 number has variable bit-size and that is a way of +%% extracting only one number in a binary and continuing parsing the binary +%% for other kind of data (e.g. different encoding). +%% FIXME: Only decodes unsigned data! +-spec leb128_decode(binary()) -> {integer(), binary()}. +leb128_decode(LebNum) -> + leb128_decode(LebNum, 0, <<>>). + +-spec leb128_decode(binary(), integer(), binary()) -> {integer(), binary()}. +leb128_decode(LebNum, NoOfBits, Acc) -> + <<Sentinel:1/bits, NextBundle:7/bits, MoreLebNums/bits>> = LebNum, + case Sentinel of + <<1:1>> -> % more bytes to follow + leb128_decode(MoreLebNums, NoOfBits+7, <<NextBundle:7/bits, Acc/bits>>); + <<0:1>> -> % byte bundle stop + Size = NoOfBits+7, + <<Num:Size/integer>> = <<NextBundle:7/bits, Acc/bits>>, + {Num, MoreLebNums} + end. + +%% @doc Extract ELF Class from ELF header and export symbol to process +%% dictionary. +-spec set_architecture_flag(elf()) -> 'ok'. +set_architecture_flag(Elf) -> + %% Extract information about ELF Class from ELF Header + <<16#7f, $E, $L, $F, EI_Class, _MoreHeader/binary>> + = get_binary_segment(Elf, 0, ?ELF_EHDR_SIZE), + put(elf_class, EI_Class), + ok. + +%% @doc Read from object file header if the file class is ELF32 or ELF64. +-spec is64bit() -> boolean(). +is64bit() -> + case get(elf_class) of + ?ELFCLASS64 -> true; + ?ELFCLASS32 -> false + end. diff --git a/lib/hipe/llvm/elf_format.hrl b/lib/hipe/llvm/elf_format.hrl new file mode 100644 index 0000000000..78592e6e2a --- /dev/null +++ b/lib/hipe/llvm/elf_format.hrl @@ -0,0 +1,488 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%------------------------------------------------------------------------------ +%% +%% ELF Header File +%% +%%------------------------------------------------------------------------------ + +-ifdef(BIT32). +-include("elf32_format.hrl"). % ELF32-specific definitions. +-else. +-include("elf64_format.hrl"). % ELF64-specific definitions. +-endif. + +%%------------------------------------------------------------------------------ +%% ELF Data Types (in bytes) +%%------------------------------------------------------------------------------ +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF File Header +%%------------------------------------------------------------------------------ +-define(ELF_EHDR_SIZE, (?E_IDENT_SIZE + ?E_TYPE_SIZE + ?E_MACHINE_SIZE + +?E_VERSION_SIZE + ?E_ENTRY_SIZE + ?E_PHOFF_SIZE + +?E_SHOFF_SIZE + ?E_FLAGS_SIZE + ?E_EHSIZE_SIZE + +?E_PHENTSIZE_SIZE + ?E_PHNUM_SIZE + ?E_SHENTSIZE_SIZE + +?E_SHNUM_SIZE + ?E_SHSTRNDX_SIZE) ). + +-define(E_IDENT_SIZE, (16 * ?ELF_UNSIGNED_CHAR_SIZE) ). +-define(E_TYPE_SIZE, ?ELF_HALF_SIZE). +-define(E_MACHINE_SIZE, ?ELF_HALF_SIZE). +-define(E_VERSION_SIZE, ?ELF_WORD_SIZE). +-define(E_ENTRY_SIZE, ?ELF_ADDR_SIZE). +-define(E_PHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_SHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(E_EHSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_SHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHSTRNDX_SIZE, ?ELF_HALF_SIZE). + +%% Useful arithmetics for computing byte offsets for various File Header +%% entries from a File Header (erlang) binary +-define(E_IDENT_OFFSET, 0). +-define(E_TYPE_OFFSET, (?E_IDENT_OFFSET + ?E_IDENT_SIZE) ). +-define(E_MACHINE_OFFSET, (?E_TYPE_OFFSET + ?E_TYPE_SIZE) ). +-define(E_VERSION_OFFSET, (?E_MACHINE_OFFSET + ?E_MACHINE_SIZE) ). +-define(E_ENTRY_OFFSET, (?E_VERSION_OFFSET + ?E_VERSION_SIZE) ). +-define(E_PHOFF_OFFSET, (?E_ENTRY_OFFSET + ?E_ENTRY_SIZE) ). +-define(E_SHOFF_OFFSET, (?E_PHOFF_OFFSET + ?E_PHOFF_SIZE) ). +-define(E_FLAGS_OFFSET, (?E_SHOFF_OFFSET + ?E_SHOFF_SIZE) ). +-define(E_EHSIZE_OFFSET, (?E_FLAGS_OFFSET + ?E_FLAGS_SIZE) ). +-define(E_PHENTSIZE_OFFSET, (?E_EHSIZE_OFFSET + ?E_EHSIZE_SIZE) ). +-define(E_PHNUM_OFFSET, (?E_PHENTSIZE_OFFSET + ?E_PHENTSIZE_SIZE) ). +-define(E_SHENTSIZE_OFFSET, (?E_PHNUM_OFFSET + ?E_PHNUM_SIZE) ). +-define(E_SHNUM_OFFSET, (?E_SHENTSIZE_OFFSET + ?E_SHENTSIZE_SIZE) ). +-define(E_SHSTRNDX_OFFSET, (?E_SHNUM_OFFSET + ?E_SHNUM_SIZE) ). + +%% Name aliases of File Header fields information used in get_header_field +%% function of elf64_format module. +-define(E_IDENT, {?E_IDENT_OFFSET, ?E_IDENT_SIZE}). +-define(E_TYPE, {?E_TYPE_OFFSET, ?E_TYPE_SIZE}). +-define(E_MACHINE, {?E_MACHINE_OFFSET, ?E_MACHINE_SIZE}). +-define(E_VERSION, {?E_VERSION_OFFSET, ?E_VERSION_SIZE}) +-define(E_ENTRY, {?E_ENTRY_OFFSET, ?E_ENTRY_SIZE}). +-define(E_PHOFF, {?E_PHOFF_OFFSET, ?E_PHOFF_SIZE}). +-define(E_SHOFF, {?E_SHOFF_OFFSET, ?E_SHOFF_SIZE}). +-define(E_FLAGS, {?E_FLAGS_OFFSET, ?E_FLAGS_SIZE}). +-define(E_EHSIZE, {?E_EHSIZE_OFFSET, ?E_EHSIZE_SIZE}). +-define(E_PHENTSIZE, {?E_PHENTSIZE_OFFSET, ?E_PHENTSIZE_SIZE}). +-define(E_PHNUM, {?E_PHNUM_OFFSET, ?E_PHNUM_SIZE}). +-define(E_SHENTSIZE, {?E_SHENTSIZE_OFFSET, ?E_SHENTSIZE_SIZE}). +-define(E_SHNUM, {?E_SHNUM_OFFSET, ?E_SHNUM_SIZE}). +-define(E_SHSTRNDX, {?E_SHSTRNDX_OFFSET, ?E_SHSTRNDX_SIZE}). + +%% ELF Identification (e_ident) +-define(EI_MAG0, 0). +-define(EI_MAG1, 1). +-define(EI_MAG2, 2). +-define(EI_MAG3, 3). +-define(EI_CLASS, 4). +-define(EI_DATA, 5). +-define(EI_VERSION, 6). +-define(EI_OSABI, 7). +-define(EI_ABIVERSION, 8). +-define(EI_PAD, 9). +-define(EI_NIDENT, 16). + +%% Object File Classes (e_ident[EI_CLASS]) +-define(ELFCLASSNONE, 0). +-define(ELFCLASS32, 1). +-define(ELFCLASS64, 2). + +%% Data Encodings (e_ident[EI_DATA]) +-define(ELFDATA2LSB, 1). +-define(ELFDATA2MSB, 2). + +%% Operating System and ABI Identifiers (e_ident[EI_OSABI]) +-define(ELFOSABI_SYSV, 0). +-define(ELFOSABI_HPUX, 1). +-define(ELFOSABI_STANDALONE, 255). + +%% Object File Types (e_type) +-define(ET_NONE, 0). +-define(ET_REL, 1). +-define(ET_EXEC, 2). +-define(ET_DYN, 3). +-define(ET_CORE, 4). +-define(ET_LOOS, 16#FE00). +-define(ET_HIOS, 16#FEFF). +-define(ET_LOPROC, 16#FF00). +-define(ET_HIPROC, 16#FFFF). + +%%------------------------------------------------------------------------------ +%% ELF Section Header +%%------------------------------------------------------------------------------ +-define(ELF_SHDRENTRY_SIZE, (?SH_NAME_SIZE + ?SH_TYPE_SIZE + ?SH_FLAGS_SIZE + +?SH_ADDR_SIZE + ?SH_OFFSET_SIZE + ?SH_SIZE_SIZE + +?SH_LINK_SIZE + ?SH_INFO_SIZE + +?SH_ADDRALIGN_SIZE + ?SH_ENTSIZE_SIZE) ). + +-define(SH_NAME_SIZE, ?ELF_WORD_SIZE). +-define(SH_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(SH_FLAGS_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ADDR_SIZE, ?ELF_ADDR_SIZE). +-define(SH_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(SH_SIZE_SIZE, ?ELF_XWORD_SIZE). +-define(SH_LINK_SIZE, ?ELF_WORD_SIZE). +-define(SH_INFO_SIZE, ?ELF_WORD_SIZE). +-define(SH_ADDRALIGN_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ENTSIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Useful arithmetics for computing byte offsets for various fields from a +%% Section Header Entry (erlang) binary +-define(SH_NAME_OFFSET, 0). +-define(SH_TYPE_OFFSET, (?SH_NAME_OFFSET + ?SH_NAME_SIZE) ). +-define(SH_FLAGS_OFFSET, (?SH_TYPE_OFFSET + ?SH_TYPE_SIZE) ). +-define(SH_ADDR_OFFSET, (?SH_FLAGS_OFFSET + ?SH_FLAGS_SIZE) ). +-define(SH_OFFSET_OFFSET, (?SH_ADDR_OFFSET + ?SH_ADDR_SIZE) ). +-define(SH_SIZE_OFFSET, (?SH_OFFSET_OFFSET + ?SH_OFFSET_SIZE) ). +-define(SH_LINK_OFFSET, (?SH_SIZE_OFFSET + ?SH_SIZE_SIZE) ). +-define(SH_INFO_OFFSET, (?SH_LINK_OFFSET + ?SH_LINK_SIZE) ). +-define(SH_ADDRALIGN_OFFSET, (?SH_INFO_OFFSET + ?SH_INFO_SIZE) ). +-define(SH_ENTSIZE_OFFSET, (?SH_ADDRALIGN_OFFSET + ?SH_ADDRALIGN_SIZE) ). + +%% Name aliases of Section Header Table entry information used in +%% get_shdrtab_entry function of elf64_format module. +-define(SH_NAME, {?SH_NAME_OFFSET, ?SH_NAME_SIZE}). +-define(SH_TYPE, {?SH_TYPE_OFFSET, ?SH_TYPE_SIZE}). +-define(SH_FLAGS, {?SH_FLAGS_OFFSET, ?SH_FLAGS_SIZE}). +-define(SH_ADDR, {?SH_ADDR_OFFSET, ?SH_ADDR_SIZE}). +-define(SH_OFFSET, {?SH_OFFSET_OFFSET, ?SH_OFFSET_SIZE}). +-define(SH_SIZE, {?SH_SIZE_OFFSET, ?SH_SIZE_SIZE}). +-define(SH_LINK, {?SH_LINK_OFFSET, ?SH_LINK_SIZE}). +-define(SH_INFO, {?SH_INFO_OFFSET, ?SH_INFO_SIZE}). +-define(SH_ADDRALIGN, {?SH_ADDRALIGN_OFFSET, ?SH_ADDRALIGN_SIZE}). +-define(SH_ENTSIZE, {?SH_ENTSIZE_OFFSET, ?SH_ENTSIZE_SIZE}). + +%% Section Indices +-define(SHN_UNDEF, 0). +-define(SHN_LOPROC, 16#FF00). +-define(SHN_HIPROC, 16#FF1F). +-define(SHN_LOOS, 16#FF20). +-define(SHN_HIOS, 16#FF3F). +-define(SHN_ABS, 16#FFF1). +-define(SHN_COMMON, 16#FFF2). + +%% Section Types (sh_type) +-define(SHT_NULL, 0). +-define(SHT_PROGBITS, 1). +-define(SHT_SYMTAB, 2). +-define(SHT_STRTAB, 3). +-define(SHT_RELA, 4). +-define(SHT_HASH, 5). +-define(SHT_DYNAMIC, 6). +-define(SHT_NOTE, 7). +-define(SHT_NOBITS, 8). +-define(SHT_REL, 9). +-define(SHT_SHLIB, 10). +-define(SHT_DYNSYM, 11). +-define(SHT_LOOS, 16#60000000). +-define(SHT_HIOS, 16#6FFFFFFF). +-define(SHT_LOPROC, 16#70000000). +-define(SHT_HIPROC, 16#7FFFFFFF). + +%% Section Attributes (sh_flags) +-define(SHF_WRITE, 16#1). +-define(SHF_ALLOC, 16#2). +-define(SHF_EXECINSTR, 16#4). +-define(SHF_MASKOS, 16#0F000000). +-define(SHF_MASKPROC, 16#F0000000). + +%% +%% Standard Section names for Code and Data +%% +-define(BSS, ".bss"). +-define(DATA, ".data"). +-define(INTERP, ".interp"). +-define(RODATA, ".rodata"). +-define(TEXT, ".text"). +%% Other Standard Section names +-define(COMMENT, ".comment"). +-define(DYNAMIC, ".dynamic"). +-define(DYNSTR, ".dynstr"). +-define(GOT, ".got"). +-define(HASH, ".hash"). +-define(NOTE(Name), (".note" ++ Name)). +-define(PLT, ".plt"). +-define(REL(Name), (".rel" ++ Name) ). +-define(RELA(Name), (".rela" ++ Name) ). +-define(SHSTRTAB, ".shstrtab"). +-define(STRTAB, ".strtab"). +-define(SYMTAB, ".symtab"). +-define(GCC_EXN_TAB, ".gcc_except_table"). + +%%------------------------------------------------------------------------------ +%% ELF Symbol Table Entries +%%------------------------------------------------------------------------------ +-define(ELF_SYM_SIZE, (?ST_NAME_SIZE + ?ST_INFO_SIZE + ?ST_OTHER_SIZE + +?ST_SHNDX_SIZE + ?ST_VALUE_SIZE + ?ST_SIZE_SIZE) ). + +-define(ST_NAME_SIZE, ?ELF_WORD_SIZE). +-define(ST_INFO_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_OTHER_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_SHNDX_SIZE, ?ELF_HALF_SIZE). +-define(ST_VALUE_SIZE, ?ELF_ADDR_SIZE). +-define(ST_SIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Precomputed offset for Symbol Table entries in SymTab binary +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for Symbol Table entry information +-define(ST_NAME, {?ST_NAME_OFFSET, ?ST_NAME_SIZE}). +-define(ST_INFO, {?ST_INFO_OFFSET, ?ST_INFO_SIZE}). +-define(ST_OTHER, {?ST_OTHER_OFFSET, ?ST_OTHER_SIZE}). +-define(ST_SHNDX, {?ST_SHNDX_OFFSET, ?ST_SHNDX_SIZE}). +-define(ST_VALUE, {?ST_VALUE_OFFSET, ?ST_VALUE_SIZE}). +-define(ST_SIZE, {?ST_SIZE_OFFSET, ?ST_SIZE_SIZE}). + +%% Macros to extract information from st_type +-define(ELF_ST_BIND(I), (I bsr 4) ). +-define(ELF_ST_TYPE(I), (I band 16#f) ). +-define(ELF_ST_INFO(B,T), (B bsl 4 + T band 16#f) ). + +%% Symbol Bindings +-define(STB_LOCAL, 0). +-define(STB_GLOBAL, 1). +-define(STB_WEAK, 2). +-define(STB_LOOS, 10). +-define(STB_HIOS, 12). +-define(STB_LOPROC, 13). +-define(STB_HIPROC, 15). + +%% Symbol Types +-define(STT_NOTYPE, 0). +-define(STT_OBJECT, 1). +-define(STT_FUNC, 2). +-define(STT_SECTION, 3). +-define(STT_FILE, 4). +-define(STT_LOOS, 10). +-define(STT_HIOS, 12). +-define(STT_LOPROC, 13). +-define(STT_HIPROC, 15). + +%%------------------------------------------------------------------------------ +%% ELF Relocation Entries +%%------------------------------------------------------------------------------ +-define(ELF_REL_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE) ). +-define(ELF_RELA_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE + ?R_ADDEND_SIZE) ). + +-define(R_OFFSET_SIZE, ?ELF_ADDR_SIZE). +-define(R_INFO_SIZE, ?ELF_XWORD_SIZE). +-define(R_ADDEND_SIZE, ?ELF_SXWORD_SIZE). + +%% Arithmetics for computing byte offsets in a Relocation entry binary +-define(R_OFFSET_OFFSET, 0). +-define(R_INFO_OFFSET, (?R_OFFSET_OFFSET + ?R_OFFSET_SIZE) ). +-define(R_ADDEND_OFFSET, (?R_INFO_OFFSET + ?R_INFO_SIZE) ). + +%% Name aliases for Relocation field information +-define(R_OFFSET, {?R_OFFSET_OFFSET, ?R_OFFSET_SIZE}). +-define(R_INFO, {?R_INFO_OFFSET, ?R_INFO_SIZE}). +-define(R_ADDEND, {?R_ADDEND_OFFSET, ?R_ADDEND_SIZE}). + +%% Useful macros to extract information from r_info field +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF Program Header Table +%%------------------------------------------------------------------------------ +-define(ELF_PHDR_SIZE, (?P_TYPE_SIZE + ?P_FLAGS_SIZE + ?P_OFFSET_SIZE + +?P_VADDR_SIZE + ?P_PADDR_SIZE + ?P_FILESZ_SIZE + +?P_MEMSZ_SIZE + ?P_ALIGN_SIZE) ). + +-define(P_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(P_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(P_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(P_VADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_PADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_FILESZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_MEMSZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_ALIGN_SIZE, ?ELF_XWORD_SIZE). + +%% Offsets of various fields in a Program Header Table entry binary. +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for each Program Header Table entry field information. +-define(P_TYPE, {?P_TYPE_OFFSET, ?P_TYPE_SIZE} ). +-define(P_FLAGS, {?P_FLAGS_OFFSET, ?P_FLAGS_SIZE} ). +-define(P_OFFSET, {?P_OFFSET_OFFSET, ?P_OFFSET_SIZE} ). +-define(P_VADDR, {?P_VADDR_OFFSET, ?P_VADDR_SIZE} ). +-define(P_PADDR, {?P_PADDR_OFFSET, ?P_PADDR_SIZE} ). +-define(P_FILESZ, {?P_FILESZ_OFFSET, ?P_FILESZ_SIZE} ). +-define(P_MEMSZ, {?P_MEMSZ_OFFSET, ?P_MEMSZ_SIZE} ). +-define(P_ALIGN, {?P_ALIGN_OFFSET, ?P_ALIGN_SIZE} ). + +%% Segment Types (p_type) +-define(PT_NULL, 0). +-define(PT_LOAD, 1). +-define(PT_DYNAMIC, 2). +-define(PT_INTERP, 3). +-define(PT_NOTE, 4). +-define(PT_SHLIB, 5). +-define(PT_PHDR, 6). +-define(PT_LOOS, 16#60000000). +-define(PT_HIOS, 16#6FFFFFFF). +-define(PT_LOPROC, 16#70000000). +-define(PT_HIPROC, 16#7FFFFFFF). + +%% Segment Attributes (p_flags) +-define(PF_X, 16#1). +-define(PF_W, 16#2). +-define(PF_R, 16#4). +-define(PF_MASKOS, 16#00FF0000). +-define(PF_MASKPROC, 16#FF000000). + +%%------------------------------------------------------------------------------ +%% ELF Dynamic Table +%%------------------------------------------------------------------------------ +-define(ELF_DYN_SIZE, (?D_TAG_SIZE + ?D_VAL_PTR_SIZE) ). + +-define(D_TAG_SIZE, ?ELF_SXWORD_SIZE). +-define(D_VAL_PTR_SIZE, ?ELF_ADDR_SIZE). + +%% Offsets of each field in Dynamic Table entry in binary +-define(D_TAG_OFFSET, 0). +-define(D_VAL_PTR_OFFSET, (?D_TAG_OFFSET + ?D_TAG_SIZE)). + +%% Name aliases for each field of a Dynamic Table entry information +-define(D_TAG, {?D_TAG_OFFSET, ?D_TAG_SIZE} ). +-define(D_VAL_PTR, {?D_VAL_PTR_OFFSET, ?D_VAL_PTR_SIZE} ). + +%% Dynamic Table Entries +-define(DT_NULL, 0). +-define(DT_NEEDED, 1). +-define(DT_PLTRELSZ, 2). +-define(DT_PLTGOT, 3). +-define(DT_HASH, 4). +-define(DT_STRTAB, 5). +-define(DT_SYMTAB, 6). +-define(DT_RELA, 7). +-define(DT_RELASZ, 8). +-define(DT_RELAENT, 9). +-define(DT_STRSZ, 10). +-define(DT_SYMENT, 11). +-define(DT_INIT, 12). +-define(DT_FINI, 13). +-define(DT_SONAME, 14). +-define(DT_RPATH, 15). +-define(DT_SYMBOLIC, 16). +-define(DT_REL, 17). +-define(DT_RELSZ, 18). +-define(DT_RELENT, 19). +-define(DT_PLTREL, 20). +-define(DT_DEBUG, 21). +-define(DT_TEXTREL, 22). +-define(DT_JMPREL, 23). +-define(DT_BIND_NOW, 24). +-define(DT_INIT_ARRAY, 25). +-define(DT_FINI_ARRAY, 26). +-define(DT_INIT_ARRAYSZ, 27). +-define(DT_FINI_ARRAYSZ, 28). +-define(DT_LOOS, 16#60000000). +-define(DT_HIOS, 16#6FFFFFFF). +-define(DT_LOPROC, 16#700000000). +-define(DT_HIPROC, 16#7FFFFFFFF). + +%%------------------------------------------------------------------------------ +%% ELF GCC Exception Table +%%------------------------------------------------------------------------------ + +%% The DWARF Exception Header Encoding is used to describe the type of data used +%% in the .eh_frame_hdr (and .gcc_except_table) section. The upper 4 bits +%% indicate how the value is to be applied. The lower 4 bits indicate the format +%% of the data. + +%% DWARF Exception Header value format +-define(DW_EH_PE_omit, 16#ff). % No value is present. +-define(DW_EH_PE_uleb128, 16#01). % Unsigned value encoded using LEB128. +-define(DW_EH_PE_udata2, 16#02). % A 2 bytes unsigned value. +-define(DW_EH_PE_udata4, 16#03). % A 4 bytes unsigned value. +-define(DW_EH_PE_udata8, 16#04). % An 8 bytes unsigned value. +-define(DW_EH_PE_sleb128, 16#09). % Signed value encoded using LEB128. +-define(DW_EH_PE_sdata2, 16#0a). % A 2 bytes signed value. +-define(DW_EH_PE_sdata4, 16#0b). % A 4 bytes signed value. +-define(DW_EH_PE_sdata8, 16#0c). % An 8 bytes signed value. + +%% DWARF Exception Header application +-define(DW_EH_PE_absptr, 16#00). % Value is used with no modification. +-define(DW_EH_PE_pcrel, 16#10). % Value is relative to the current PC. +-define(DW_EH_PE_datarel, 16#30). % Value is relative to the beginning of the + % section. + +%%------------------------------------------------------------------------------ +%% ELF Read-only data (constants, literlas etc.) +%%------------------------------------------------------------------------------ +-define(RO_ENTRY_SIZE, 8). + +%%------------------------------------------------------------------------------ +%% Custom Note section: ".note.gc" for Erlang GC +%%------------------------------------------------------------------------------ + +%% The structure of this section is the following: +%% +%% .short <n> # number of safe points in code +%% +%% .long .L<label1> # safe point address | +%% .long .L<label2> # safe point address |-> safe point addrs +%% ..... | +%% .long .L<label3> # safe point address | +%% +%% .short <n> # stack frame size (in words) |-> fixed-size part +%% .short <n> # stack arity | +%% .short <n> # number of live roots that follow | +%% +%% .short <n> # live root's stack index | +%% ..... |-> live root indices +%% .short <n> # >> | + +%% The name of the custom Note Section +-define(NOTE_ERLGC_NAME, ".gc"). + +%% The first word of a Note Section for Erlang GC (".note.gc") is always the +%% number of safepoints in code. +-define(SP_COUNT, {?SP_COUNT_OFFSET, ?SP_COUNT_SIZE}). +-define(SP_COUNT_SIZE, ?ELF_HALF_SIZE). +-define(SP_COUNT_OFFSET, 0). %(always the first entry in sdesc) + +%% The fixed-size part of a safe point (SP) entry consists of 4 words: the SP +%% address (offset in code), the stack frame size of the function (where the SP +%% is located), the stack arity of the function (the registered values are *not* +%% counted), the number of live roots in the specific SP. +-define(SP_FIXED, {?SP_FIXED_OFF, ?SP_FIXED_SIZE}). +-define(SP_FIXED_OFF, 0). +%%XXX: Exclude SP_ADDR_SIZE from SP_FIXED_SIZE in lew of new GC layout +-define(SP_FIXED_SIZE, (?SP_STKFRAME_SIZE + ?SP_STKARITY_SIZE + + ?SP_LIVEROOTCNT_SIZE)). + +-define(SP_ADDR_SIZE, ?ELF_WORD_SIZE). +-define(SP_STKFRAME_SIZE, ?ELF_HALF_SIZE). +-define(SP_STKARITY_SIZE, ?ELF_HALF_SIZE). +-define(SP_LIVEROOTCNT_SIZE, ?ELF_HALF_SIZE). + +%%XXX: SP_STKFRAME is the first piece of information in the new GC layout +-define(SP_STKFRAME_OFFSET, 0). +-define(SP_STKARITY_OFFSET, (?SP_STKFRAME_OFFSET + ?SP_STKFRAME_SIZE) ). +-define(SP_LIVEROOTCNT_OFFSET, (?SP_STKARITY_OFFSET + ?SP_STKARITY_SIZE) ). + +%% Name aliases for safepoint fields. +-define(SP_STKFRAME, {?SP_STKFRAME_OFFSET, ?SP_STKFRAME_SIZE}). +-define(SP_STKARITY, {?SP_STKARITY_OFFSET, ?SP_STKARITY_SIZE}). +-define(SP_LIVEROOTCNT, {?SP_LIVEROOTCNT_OFFSET, ?SP_LIVEROOTCNT_SIZE}). + +%% After the fixed-size part a variable-size part exists. This part holds the +%% stack frame index of every live root in the specific SP. +-define(LR_STKINDEX_SIZE, ?ELF_HALF_SIZE). + +%%------------------------------------------------------------------------------ +%% Misc. +%%------------------------------------------------------------------------------ +-define(bits(Bytes), ((Bytes) bsl 3)). diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl new file mode 100644 index 0000000000..5e33731a2b --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -0,0 +1,1131 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_llvm). + +-export([ + mk_ret/1, + ret_ret_list/1, + + mk_br/1, + br_dst/1, + + mk_br_cond/3, + mk_br_cond/4, + br_cond_cond/1, + br_cond_true_label/1, + br_cond_false_label/1, + br_cond_meta/1, + + mk_indirectbr/3, + indirectbr_type/1, + indirectbr_address/1, + indirectbr_label_list/1, + + mk_switch/4, + switch_type/1, + switch_value/1, + switch_default_label/1, + switch_value_label_list/1, + + mk_invoke/9, + invoke_dst/1, + invoke_cconv/1, + invoke_ret_attrs/1, + invoke_type/1, + invoke_fnptrval/1, + invoke_arglist/1, + invoke_fn_attrs/1, + invoke_to_label/1, + invoke_unwind_label/1, + + mk_operation/6, + operation_dst/1, + operation_op/1, + operation_type/1, + operation_src1/1, + operation_src2/1, + operation_options/1, + + mk_extractvalue/5, + extractvalue_dst/1, + extractvalue_type/1, + extractvalue_val/1, + extractvalue_idx/1, + extractvalue_idxs/1, + + mk_insertvalue/7, + insertvalue_dst/1, + insertvalue_val_type/1, + insertvalue_val/1, + insertvalue_elem_type/1, + insertvalue_elem/1, + insertvalue_idx/1, + insertvalue_idxs/1, + + mk_alloca/4, + alloca_dst/1, + alloca_type/1, + alloca_num/1, + alloca_align/1, + + mk_load/6, + load_dst/1, + load_p_type/1, + load_pointer/1, + load_alignment/1, + load_nontemporal/1, + load_volatile/1, + + mk_store/7, + store_type/1, + store_value/1, + store_p_type/1, + store_pointer/1, + store_alignment/1, + store_nontemporal/1, + store_volatile/1, + + mk_getelementptr/5, + getelementptr_dst/1, + getelementptr_p_type/1, + getelementptr_value/1, + getelementptr_typed_idxs/1, + getelementptr_inbounds/1, + + mk_conversion/5, + conversion_dst/1, + conversion_op/1, + conversion_src_type/1, + conversion_src/1, + conversion_dst_type/1, + + mk_sitofp/4, + sitofp_dst/1, + sitofp_src_type/1, + sitofp_src/1, + sitofp_dst_type/1, + + mk_ptrtoint/4, + ptrtoint_dst/1, + ptrtoint_src_type/1, + ptrtoint_src/1, + ptrtoint_dst_type/1, + + mk_inttoptr/4, + inttoptr_dst/1, + inttoptr_src_type/1, + inttoptr_src/1, + inttoptr_dst_type/1, + + mk_icmp/5, + icmp_dst/1, + icmp_cond/1, + icmp_type/1, + icmp_src1/1, + icmp_src2/1, + + mk_fcmp/5, + fcmp_dst/1, + fcmp_cond/1, + fcmp_type/1, + fcmp_src1/1, + fcmp_src2/1, + + mk_phi/3, + phi_dst/1, + phi_type/1, + phi_value_label_list/1, + + mk_select/6, + select_dst/1, + select_cond/1, + select_typ1/1, + select_val1/1, + select_typ2/1, + select_val2/1, + + mk_call/8, + call_dst/1, + call_is_tail/1, + call_cconv/1, + call_ret_attrs/1, + call_type/1, + call_fnptrval/1, + call_arglist/1, + call_fn_attrs/1, + + mk_fun_def/10, + fun_def_linkage/1, + fun_def_visibility/1, + fun_def_cconv/1, + fun_def_ret_attrs/1, + fun_def_type/1, + fun_def_name/1, + fun_def_arglist/1, + fun_def_fn_attrs/1, + fun_def_align/1, + fun_def_body/1, + + mk_fun_decl/8, + fun_decl_linkage/1, + fun_decl_visibility/1, + fun_decl_cconv/1, + fun_decl_ret_attrs/1, + fun_decl_type/1, + fun_decl_name/1, + fun_decl_arglist/1, + fun_decl_align/1, + + mk_landingpad/0, + + mk_comment/1, + comment_text/1, + + mk_label/1, + label_label/1, + is_label/1, + + mk_const_decl/4, + const_decl_dst/1, + const_decl_decl_type/1, + const_decl_type/1, + const_decl_value/1, + + mk_asm/1, + asm_instruction/1, + + mk_adj_stack/3, + adj_stack_offset/1, + adj_stack_register/1, + adj_stack_type/1, + + mk_branch_meta/3, + branch_meta_id/1, + branch_meta_true_weight/1, + branch_meta_false_weight/1 + ]). + +-export([ + mk_void/0, + + mk_label_type/0, + + mk_int/1, + int_width/1, + + mk_double/0, + + mk_pointer/1, + pointer_type/1, + + mk_array/2, + array_size/1, + array_type/1, + + mk_vector/2, + vector_size/1, + vector_type/1, + + mk_struct/1, + struct_type_list/1, + + mk_fun/2, + function_ret_type/1, + function_arg_type_list/1 + ]). + +-export([pp_ins_list/2, pp_ins/2]). + + +%%----------------------------------------------------------------------------- +%% Abstract Data Types for LLVM Assembly. +%%----------------------------------------------------------------------------- + +%% Terminator Instructions +-record(llvm_ret, {ret_list=[]}). +-type llvm_ret() :: #llvm_ret{}. + +-record(llvm_br, {dst}). +-type llvm_br() :: #llvm_br{}. + +-record(llvm_br_cond, {'cond', true_label, false_label, meta=[]}). +-type llvm_br_cond() :: #llvm_br_cond{}. + +-record(llvm_indirectbr, {type, address, label_list}). +-type llvm_indirectbr() :: #llvm_indirectbr{}. + +-record(llvm_switch, {type, value, default_label, value_label_list=[]}). +-type llvm_switch() :: #llvm_switch{}. + +-record(llvm_invoke, {dst, cconv=[], ret_attrs=[], type, fnptrval, arglist=[], + fn_attrs=[], to_label, unwind_label}). +-type llvm_invoke() :: #llvm_invoke{}. + +%% Binary Operations +-record(llvm_operation, {dst, op, type, src1, src2, options=[]}). +-type llvm_operation() :: #llvm_operation{}. + +%% Aggregate Operations +-record(llvm_extractvalue, {dst, type, val, idx, idxs=[]}). +-type llvm_extractvalue() :: #llvm_extractvalue{}. + +-record(llvm_insertvalue, {dst, val_type, val, elem_type, elem, idx, idxs=[]}). +-type llvm_insertvalue() :: #llvm_insertvalue{}. + +%% Memory Access and Addressing Operations +-record(llvm_alloca, {dst, type, num=[], align=[]}). +-type llvm_alloca() :: #llvm_alloca{}. + +-record(llvm_load, {dst, p_type, pointer, alignment=[], nontemporal=[], + volatile=false}). +-type llvm_load() :: #llvm_load{}. + +-record(llvm_store, {type, value, p_type, pointer, alignment=[], + nontemporal=[], volatile=false}). +-type llvm_store() :: #llvm_store{}. + +-record(llvm_getelementptr, {dst, p_type, value, typed_idxs, inbounds}). +-type llvm_getelementptr() :: #llvm_getelementptr{}. + +%% Conversion Operations +-record(llvm_conversion, {dst, op, src_type, src, dst_type}). +-type llvm_conversion() :: #llvm_conversion{}. + +-record(llvm_sitofp, {dst, src_type, src, dst_type}). +-type llvm_sitofp() :: #llvm_sitofp{}. + +-record(llvm_ptrtoint, {dst, src_type, src, dst_type}). +-type llvm_ptrtoint() :: #llvm_ptrtoint{}. + +-record(llvm_inttoptr, {dst, src_type, src, dst_type}). +-type llvm_inttoptr() :: #llvm_inttoptr{}. + +%% Other Operations +-record(llvm_icmp, {dst, 'cond', type, src1, src2}). +-type llvm_icmp() :: #llvm_icmp{}. + +-record(llvm_fcmp, {dst, 'cond', type, src1, src2}). +-type llvm_fcmp() :: #llvm_fcmp{}. + +-record(llvm_phi, {dst, type, value_label_list}). +-type llvm_phi() :: #llvm_phi{}. + +-record(llvm_select, {dst, 'cond', typ1, val1, typ2, val2}). +-type llvm_select() :: #llvm_select{}. + +-record(llvm_call, {dst=[], is_tail = false, cconv = [], ret_attrs = [], type, + fnptrval, arglist = [], fn_attrs = []}). +-type llvm_call() :: #llvm_call{}. + +-record(llvm_fun_def, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], fn_attrs=[], align=[], body=[]}). +-type llvm_fun_def() :: #llvm_fun_def{}. + +-record(llvm_fun_decl, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], align=[]}). +-type llvm_fun_decl() :: #llvm_fun_decl{}. + +-record(llvm_landingpad, {}). +-type llvm_landingpad() :: #llvm_landingpad{}. + +-record(llvm_comment, {text}). +-type llvm_comment() :: #llvm_comment{}. + +-record(llvm_label, {label}). +-type llvm_label() :: #llvm_label{}. + +-record(llvm_const_decl, {dst, decl_type, type, value}). +-type llvm_const_decl() :: #llvm_const_decl{}. + +-record(llvm_asm, {instruction}). +-type llvm_asm() :: #llvm_asm{}. + +-record(llvm_adj_stack, {offset, 'register', type}). +-type llvm_adj_stack() :: #llvm_adj_stack{}. + +-record(llvm_branch_meta, {id, true_weight, false_weight}). +-type llvm_branch_meta() :: #llvm_branch_meta{}. + +%% A type for any LLVM instruction +-type llvm_instr() :: llvm_ret() | llvm_br() | llvm_br_cond() + | llvm_indirectbr() | llvm_switch() | llvm_invoke() + | llvm_operation() | llvm_extractvalue() + | llvm_insertvalue() | llvm_alloca() | llvm_load() + | llvm_store() | llvm_getelementptr() | llvm_conversion() + | llvm_sitofp() | llvm_ptrtoint() | llvm_inttoptr() + | llvm_icmp() | llvm_fcmp() | llvm_phi() | llvm_select() + | llvm_call() | llvm_fun_def() | llvm_fun_decl() + | llvm_landingpad() | llvm_comment() | llvm_label() + | llvm_const_decl() | llvm_asm() | llvm_adj_stack() + | llvm_branch_meta(). + +%% Types +-record(llvm_void, {}). +%-type llvm_void() :: #llvm_void{}. + +-record(llvm_label_type, {}). +%-type llvm_label_type() :: #llvm_label_type{}. + +-record(llvm_int, {width}). +%-type llvm_int() :: #llvm_int{}. + +-record(llvm_float, {}). +%-type llvm_float() :: #llvm_float{}. + +-record(llvm_double, {}). +%-type llvm_double() :: #llvm_double{}. + +-record(llvm_fp80, {}). +%-type llvm_fp80() :: #llvm_fp80{}. + +-record(llvm_fp128, {}). +%-type llvm_fp128() :: #llvm_fp128{}. + +-record(llvm_ppc_fp128, {}). +%-type llvm_ppc_fp128() :: #llvm_ppc_fp128{}. + +-record(llvm_pointer, {type}). +%-type llvm_pointer() :: #llvm_pointer{}. + +-record(llvm_vector, {'size', type}). +%-type llvm_vector() :: #llvm_vector{}. + +-record(llvm_struct, {type_list}). +%-type llvm_struct() :: #llvm_struct{}. + +-record(llvm_array, {'size', type}). +%-type llvm_array() :: #llvm_array{}. + +-record(llvm_fun, {ret_type, arg_type_list}). +%-type llvm_fun() :: #llvm_fun{}. + +%%----------------------------------------------------------------------------- +%% Accessor Functions +%%----------------------------------------------------------------------------- + +%% ret +mk_ret(Ret_list) -> #llvm_ret{ret_list=Ret_list}. +ret_ret_list(#llvm_ret{ret_list=Ret_list}) -> Ret_list. + +%% br +mk_br(Dst) -> #llvm_br{dst=Dst}. +br_dst(#llvm_br{dst=Dst}) -> Dst. + +%% br_cond +mk_br_cond(Cond, True_label, False_label) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label}. +mk_br_cond(Cond, True_label, False_label, Metadata) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label, + meta=Metadata}. +br_cond_cond(#llvm_br_cond{'cond'=Cond}) -> Cond. +br_cond_true_label(#llvm_br_cond{true_label=True_label}) -> True_label. +br_cond_false_label(#llvm_br_cond{false_label=False_label}) -> + False_label. +br_cond_meta(#llvm_br_cond{meta=Metadata}) -> Metadata. + +%% indirectbr +mk_indirectbr(Type, Address, Label_list) -> #llvm_indirectbr{type=Type, address=Address, label_list=Label_list}. +indirectbr_type(#llvm_indirectbr{type=Type}) -> Type. +indirectbr_address(#llvm_indirectbr{address=Address}) -> Address. +indirectbr_label_list(#llvm_indirectbr{label_list=Label_list}) -> Label_list. + +%% invoke +mk_invoke(Dst, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs, To_label, Unwind_label) -> + #llvm_invoke{dst=Dst, cconv=Cconv, ret_attrs=Ret_attrs, type=Type, + fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs, to_label=To_label, + unwind_label=Unwind_label}. +invoke_dst(#llvm_invoke{dst=Dst}) -> Dst. +invoke_cconv(#llvm_invoke{cconv=Cconv}) -> Cconv. +invoke_ret_attrs(#llvm_invoke{ret_attrs=Ret_attrs}) -> Ret_attrs. +invoke_type(#llvm_invoke{type=Type}) -> Type. +invoke_fnptrval(#llvm_invoke{fnptrval=Fnptrval}) -> Fnptrval. +invoke_arglist(#llvm_invoke{arglist=Arglist}) -> Arglist. +invoke_fn_attrs(#llvm_invoke{fn_attrs=Fn_attrs}) -> Fn_attrs. +invoke_to_label(#llvm_invoke{to_label=To_label}) -> To_label. +invoke_unwind_label(#llvm_invoke{unwind_label=Unwind_label}) -> Unwind_label. + +%% switch +mk_switch(Type, Value, Default_label, Value_label_list) -> + #llvm_switch{type=Type, value=Value, default_label=Default_label, + value_label_list=Value_label_list}. +switch_type(#llvm_switch{type=Type}) -> Type. +switch_value(#llvm_switch{value=Value}) -> Value. +switch_default_label(#llvm_switch{default_label=Default_label}) -> + Default_label. +switch_value_label_list(#llvm_switch{value_label_list=Value_label_list}) -> + Value_label_list. + +%% operation +mk_operation(Dst, Op, Type, Src1, Src2, Options) -> + #llvm_operation{dst=Dst, op=Op, type=Type, src1=Src1, src2=Src2, + options=Options}. +operation_dst(#llvm_operation{dst=Dst}) -> Dst. +operation_op(#llvm_operation{op=Op}) -> Op. +operation_type(#llvm_operation{type=Type}) -> Type. +operation_src1(#llvm_operation{src1=Src1}) -> Src1. +operation_src2(#llvm_operation{src2=Src2}) -> Src2. +operation_options(#llvm_operation{options=Options}) -> Options. + +%% extractvalue +mk_extractvalue(Dst, Type, Val, Idx, Idxs) -> + #llvm_extractvalue{dst=Dst,type=Type,val=Val,idx=Idx,idxs=Idxs}. +extractvalue_dst(#llvm_extractvalue{dst=Dst}) -> Dst. +extractvalue_type(#llvm_extractvalue{type=Type}) -> Type. +extractvalue_val(#llvm_extractvalue{val=Val}) -> Val. +extractvalue_idx(#llvm_extractvalue{idx=Idx}) -> Idx. +extractvalue_idxs(#llvm_extractvalue{idxs=Idxs}) -> Idxs. + +%% insertvalue +mk_insertvalue(Dst, Val_type, Val, Elem_type, Elem, Idx, Idxs) -> + #llvm_insertvalue{dst=Dst, val_type=Val_type, val=Val, elem_type=Elem_type, + elem=Elem, idx=Idx, idxs=Idxs}. +insertvalue_dst(#llvm_insertvalue{dst=Dst}) -> Dst. +insertvalue_val_type(#llvm_insertvalue{val_type=Val_type}) -> Val_type. +insertvalue_val(#llvm_insertvalue{val=Val}) -> Val. +insertvalue_elem_type(#llvm_insertvalue{elem_type=Elem_type}) -> Elem_type. +insertvalue_elem(#llvm_insertvalue{elem=Elem}) -> Elem. +insertvalue_idx(#llvm_insertvalue{idx=Idx}) -> Idx. +insertvalue_idxs(#llvm_insertvalue{idxs=Idxs}) -> Idxs. + +%% alloca +mk_alloca(Dst, Type, Num, Align) -> + #llvm_alloca{dst=Dst, type=Type, num=Num, align=Align}. +alloca_dst(#llvm_alloca{dst=Dst}) -> Dst. +alloca_type(#llvm_alloca{type=Type}) -> Type. +alloca_num(#llvm_alloca{num=Num}) -> Num. +alloca_align(#llvm_alloca{align=Align}) -> Align. + +%% load +mk_load(Dst, Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_load{dst=Dst, p_type=Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +load_dst(#llvm_load{dst=Dst}) -> Dst. +load_p_type(#llvm_load{p_type=Type}) -> Type. +load_pointer(#llvm_load{pointer=Pointer}) -> Pointer. +load_alignment(#llvm_load{alignment=Alignment}) -> Alignment. +load_nontemporal(#llvm_load{nontemporal=Nontemporal}) -> Nontemporal. +load_volatile(#llvm_load{volatile=Volatile}) -> Volatile. + +%% store +mk_store(Type, Value, P_Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_store{type=Type, value=Value, p_type=P_Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +store_type(#llvm_store{type=Type}) -> Type. +store_value(#llvm_store{value=Value}) -> Value. +store_p_type(#llvm_store{p_type=P_Type}) -> P_Type. +store_pointer(#llvm_store{pointer=Pointer}) -> Pointer. +store_alignment(#llvm_store{alignment=Alignment}) -> Alignment. +store_nontemporal(#llvm_store{nontemporal=Nontemporal}) -> Nontemporal. +store_volatile(#llvm_store{volatile=Volatile}) -> Volatile. + +%% getelementptr +mk_getelementptr(Dst, P_Type, Value, Typed_Idxs, Inbounds) -> + #llvm_getelementptr{dst=Dst,p_type=P_Type, value=Value, + typed_idxs=Typed_Idxs, inbounds=Inbounds}. +getelementptr_dst(#llvm_getelementptr{dst=Dst}) -> Dst. +getelementptr_p_type(#llvm_getelementptr{p_type=P_Type}) -> P_Type. +getelementptr_value(#llvm_getelementptr{value=Value}) -> Value. +getelementptr_typed_idxs(#llvm_getelementptr{typed_idxs=Typed_Idxs}) -> Typed_Idxs. +getelementptr_inbounds(#llvm_getelementptr{inbounds=Inbounds}) -> Inbounds. + +%% conversion +mk_conversion(Dst, Op, Src_type, Src, Dst_type) -> + #llvm_conversion{dst=Dst, op=Op, src_type=Src_type, src=Src, dst_type=Dst_type}. +conversion_dst(#llvm_conversion{dst=Dst}) -> Dst. +conversion_op(#llvm_conversion{op=Op}) -> Op. +conversion_src_type(#llvm_conversion{src_type=Src_type}) -> Src_type. +conversion_src(#llvm_conversion{src=Src}) -> Src. +conversion_dst_type(#llvm_conversion{dst_type=Dst_type}) -> Dst_type. + +%% sitofp +mk_sitofp(Dst, Src_type, Src, Dst_type) -> + #llvm_sitofp{dst=Dst, src_type=Src_type, src=Src, dst_type=Dst_type}. +sitofp_dst(#llvm_sitofp{dst=Dst}) -> Dst. +sitofp_src_type(#llvm_sitofp{src_type=Src_type}) -> Src_type. +sitofp_src(#llvm_sitofp{src=Src}) -> Src. +sitofp_dst_type(#llvm_sitofp{dst_type=Dst_type}) -> Dst_type. + +%% ptrtoint +mk_ptrtoint(Dst, Src_Type, Src, Dst_Type) -> + #llvm_ptrtoint{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +ptrtoint_dst(#llvm_ptrtoint{dst=Dst}) -> Dst. +ptrtoint_src_type(#llvm_ptrtoint{src_type=Src_Type}) -> Src_Type. +ptrtoint_src(#llvm_ptrtoint{src=Src}) -> Src. +ptrtoint_dst_type(#llvm_ptrtoint{dst_type=Dst_Type}) -> Dst_Type . + +%% inttoptr +mk_inttoptr(Dst, Src_Type, Src, Dst_Type) -> + #llvm_inttoptr{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +inttoptr_dst(#llvm_inttoptr{dst=Dst}) -> Dst. +inttoptr_src_type(#llvm_inttoptr{src_type=Src_Type}) -> Src_Type. +inttoptr_src(#llvm_inttoptr{src=Src}) -> Src. +inttoptr_dst_type(#llvm_inttoptr{dst_type=Dst_Type}) -> Dst_Type . + +%% icmp +mk_icmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_icmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +icmp_dst(#llvm_icmp{dst=Dst}) -> Dst. +icmp_cond(#llvm_icmp{'cond'=Cond}) -> Cond. +icmp_type(#llvm_icmp{type=Type}) -> Type. +icmp_src1(#llvm_icmp{src1=Src1}) -> Src1. +icmp_src2(#llvm_icmp{src2=Src2}) -> Src2. + +%% fcmp +mk_fcmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_fcmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +fcmp_dst(#llvm_fcmp{dst=Dst}) -> Dst. +fcmp_cond(#llvm_fcmp{'cond'=Cond}) -> Cond. +fcmp_type(#llvm_fcmp{type=Type}) -> Type. +fcmp_src1(#llvm_fcmp{src1=Src1}) -> Src1. +fcmp_src2(#llvm_fcmp{src2=Src2}) -> Src2. + +%% phi +mk_phi(Dst, Type, Value_label_list) -> + #llvm_phi{dst=Dst, type=Type,value_label_list=Value_label_list}. +phi_dst(#llvm_phi{dst=Dst}) -> Dst. +phi_type(#llvm_phi{type=Type}) -> Type. +phi_value_label_list(#llvm_phi{value_label_list=Value_label_list}) -> + Value_label_list. + +%% select +mk_select(Dst, Cond, Typ1, Val1, Typ2, Val2) -> + #llvm_select{dst=Dst, 'cond'=Cond, typ1=Typ1, val1=Val1, typ2=Typ2, val2=Val2}. +select_dst(#llvm_select{dst=Dst}) -> Dst. +select_cond(#llvm_select{'cond'=Cond}) -> Cond. +select_typ1(#llvm_select{typ1=Typ1}) -> Typ1. +select_val1(#llvm_select{val1=Val1}) -> Val1. +select_typ2(#llvm_select{typ2=Typ2}) -> Typ2. +select_val2(#llvm_select{val2=Val2}) -> Val2. + +%% call +mk_call(Dst, Is_tail, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs) -> + #llvm_call{dst=Dst, is_tail=Is_tail, cconv=Cconv, ret_attrs=Ret_attrs, + type=Type, fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs}. +call_dst(#llvm_call{dst=Dst}) -> Dst. +call_is_tail(#llvm_call{is_tail=Is_tail}) -> Is_tail. +call_cconv(#llvm_call{cconv=Cconv}) -> Cconv. +call_ret_attrs(#llvm_call{ret_attrs=Ret_attrs}) -> Ret_attrs. +call_type(#llvm_call{type=Type}) -> Type. +call_fnptrval(#llvm_call{fnptrval=Fnptrval}) -> Fnptrval. +call_arglist(#llvm_call{arglist=Arglist}) -> Arglist. +call_fn_attrs(#llvm_call{fn_attrs=Fn_attrs}) -> Fn_attrs. + +%% fun_def +mk_fun_def(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, + Fn_attrs, Align, Body) -> + #llvm_fun_def{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + fn_attrs=Fn_attrs, + align=Align, + body=Body + }. + +fun_def_linkage(#llvm_fun_def{linkage=Linkage}) -> Linkage. +fun_def_visibility(#llvm_fun_def{visibility=Visibility}) -> Visibility. +fun_def_cconv(#llvm_fun_def{cconv=Cconv}) -> Cconv . +fun_def_ret_attrs(#llvm_fun_def{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_def_type(#llvm_fun_def{type=Type}) -> Type. +fun_def_name(#llvm_fun_def{'name'=Name}) -> Name. +fun_def_arglist(#llvm_fun_def{arglist=Arglist}) -> Arglist. +fun_def_fn_attrs(#llvm_fun_def{fn_attrs=Fn_attrs}) -> Fn_attrs. +fun_def_align(#llvm_fun_def{align=Align}) -> Align. +fun_def_body(#llvm_fun_def{body=Body}) -> Body. + +%% fun_decl +mk_fun_decl(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, Align)-> + #llvm_fun_decl{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + align=Align + }. + +fun_decl_linkage(#llvm_fun_decl{linkage=Linkage}) -> Linkage. +fun_decl_visibility(#llvm_fun_decl{visibility=Visibility}) -> Visibility. +fun_decl_cconv(#llvm_fun_decl{cconv=Cconv}) -> Cconv . +fun_decl_ret_attrs(#llvm_fun_decl{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_decl_type(#llvm_fun_decl{type=Type}) -> Type. +fun_decl_name(#llvm_fun_decl{'name'=Name}) -> Name. +fun_decl_arglist(#llvm_fun_decl{arglist=Arglist}) -> Arglist. +fun_decl_align(#llvm_fun_decl{align=Align}) -> Align. + +%% landingpad +mk_landingpad() -> #llvm_landingpad{}. + +%% comment +mk_comment(Text) -> #llvm_comment{text=Text}. +comment_text(#llvm_comment{text=Text}) -> Text. + +%% label +mk_label(Label) -> #llvm_label{label=Label}. +label_label(#llvm_label{label=Label}) -> Label. + +-spec is_label(llvm_instr()) -> boolean(). +is_label(#llvm_label{}) -> true; +is_label(#llvm_ret{}) -> false; +is_label(#llvm_br{}) -> false; +is_label(#llvm_br_cond{}) -> false; +is_label(#llvm_indirectbr{}) -> false; +is_label(#llvm_switch{}) -> false; +is_label(#llvm_invoke{}) -> false; +is_label(#llvm_operation{}) -> false; +is_label(#llvm_extractvalue{}) -> false; +is_label(#llvm_insertvalue{}) -> false; +is_label(#llvm_alloca{}) -> false; +is_label(#llvm_load{}) -> false; +is_label(#llvm_store{}) -> false; +is_label(#llvm_getelementptr{}) -> false; +is_label(#llvm_conversion{}) -> false; +is_label(#llvm_sitofp{}) -> false; +is_label(#llvm_ptrtoint{}) -> false; +is_label(#llvm_inttoptr{}) -> false; +is_label(#llvm_icmp{}) -> false; +is_label(#llvm_fcmp{}) -> false; +is_label(#llvm_phi{}) -> false; +is_label(#llvm_select{}) -> false; +is_label(#llvm_call{}) -> false; +is_label(#llvm_fun_def{}) -> false; +is_label(#llvm_fun_decl{}) -> false; +is_label(#llvm_landingpad{}) -> false; +is_label(#llvm_comment{}) -> false; +is_label(#llvm_const_decl{}) -> false; +is_label(#llvm_asm{}) -> false; +is_label(#llvm_adj_stack{}) -> false; +is_label(#llvm_branch_meta{}) -> false. + +%% const_decl +mk_const_decl(Dst, Decl_type, Type, Value) -> + #llvm_const_decl{dst=Dst, decl_type=Decl_type, type=Type, value=Value}. +const_decl_dst(#llvm_const_decl{dst=Dst}) -> Dst. +const_decl_decl_type(#llvm_const_decl{decl_type=Decl_type}) -> Decl_type. +const_decl_type(#llvm_const_decl{type=Type}) -> Type. +const_decl_value(#llvm_const_decl{value=Value}) -> Value. + +%% asm +mk_asm(Instruction) -> #llvm_asm{instruction=Instruction}. +asm_instruction(#llvm_asm{instruction=Instruction}) -> Instruction. + +%% adj_stack +mk_adj_stack(Offset, Register, Type) -> + #llvm_adj_stack{offset=Offset, 'register'=Register, type=Type}. +adj_stack_offset(#llvm_adj_stack{offset=Offset}) -> Offset. +adj_stack_register(#llvm_adj_stack{'register'=Register}) -> Register. +adj_stack_type(#llvm_adj_stack{type=Type}) -> Type. + +%% branch meta-data +mk_branch_meta(Id, True_weight, False_weight) -> + #llvm_branch_meta{id=Id, true_weight=True_weight, false_weight=False_weight}. +branch_meta_id(#llvm_branch_meta{id=Id}) -> Id. +branch_meta_true_weight(#llvm_branch_meta{true_weight=True_weight}) -> + True_weight. +branch_meta_false_weight(#llvm_branch_meta{false_weight=False_weight}) -> + False_weight. + +%% types +mk_void() -> #llvm_void{}. + +mk_label_type() -> #llvm_label_type{}. + +mk_int(Width) -> #llvm_int{width=Width}. +int_width(#llvm_int{width=Width}) -> Width. + +mk_double() -> #llvm_double{}. + +mk_pointer(Type) -> #llvm_pointer{type=Type}. +pointer_type(#llvm_pointer{type=Type}) -> Type. + +mk_array(Size, Type) -> #llvm_array{'size'=Size, type=Type}. +array_size(#llvm_array{'size'=Size}) -> Size. +array_type(#llvm_array{type=Type}) -> Type. + +mk_vector(Size, Type) -> #llvm_vector{'size'=Size, type=Type}. +vector_size(#llvm_vector{'size'=Size}) -> Size. +vector_type(#llvm_vector{type=Type}) -> Type. + +mk_struct(Type_list) -> #llvm_struct{type_list=Type_list}. +struct_type_list(#llvm_struct{type_list=Type_list}) -> Type_list. + +mk_fun(Ret_type, Arg_type_list) -> + #llvm_fun{ret_type=Ret_type, arg_type_list=Arg_type_list}. +function_ret_type(#llvm_fun{ret_type=Ret_type}) -> Ret_type. +function_arg_type_list(#llvm_fun{arg_type_list=Arg_type_list}) -> + Arg_type_list. + +%%---------------------------------------------------------------------------- +%% Pretty-printer Functions +%%---------------------------------------------------------------------------- + +%% @doc Pretty-print a list of LLVM instructions to a Device. +pp_ins_list(_Dev, []) -> ok; +pp_ins_list(Dev, [I|Is]) -> + pp_ins(Dev, I), + pp_ins_list(Dev, Is). + +pp_ins(Dev, I) -> + case indent(I) of + true -> write(Dev, " "); + false -> ok + end, + case I of + #llvm_ret{} -> + write(Dev, "ret "), + case ret_ret_list(I) of + [] -> write(Dev, "void"); + List -> pp_args(Dev, List) + end, + write(Dev, "\n"); + #llvm_br{} -> + write(Dev, ["br label ", br_dst(I), "\n"]); + #llvm_switch{} -> + write(Dev, "switch "), + pp_type(Dev, switch_type(I)), + write(Dev, [" ", switch_value(I), ", label ", switch_default_label(I), + " \n [\n"]), + pp_switch_value_label_list(Dev, switch_type(I), + switch_value_label_list(I)), + write(Dev, " ]\n"); + #llvm_invoke{} -> + write(Dev, [invoke_dst(I), " = invoke ", invoke_cconv(I), " "]), + pp_options(Dev, invoke_ret_attrs(I)), + pp_type(Dev, invoke_type(I)), + write(Dev, [" ", invoke_fnptrval(I), "("]), + pp_args(Dev, invoke_arglist(I)), + write(Dev, ") "), + pp_options(Dev, invoke_fn_attrs(I)), + write(Dev, [" to label ", invoke_to_label(I)," unwind label ", + invoke_unwind_label(I), " \n"]); + #llvm_br_cond{} -> + write(Dev, ["br i1 ", br_cond_cond(I), ", label ", br_cond_true_label(I), + ", label ", br_cond_false_label(I)]), + case br_cond_meta(I) of + [] -> ok; + Metadata -> + write(Dev, [", !prof !", Metadata]) + end, + write(Dev, "\n"); + #llvm_indirectbr{} -> + write(Dev, "indirectbr "), + pp_type(Dev, indirectbr_type(I)), + write(Dev, [" ", indirectbr_address(I), ", [ "]), + pp_args(Dev, indirectbr_label_list(I)), + write(Dev, " ]\n"); + #llvm_operation{} -> + write(Dev, [operation_dst(I), " = ", atom_to_list(operation_op(I)), " "]), + case op_has_options(operation_op(I)) of + true -> pp_options(Dev, operation_options(I)); + false -> ok + end, + pp_type(Dev, operation_type(I)), + write(Dev, [" ", operation_src1(I), ", ", operation_src2(I), "\n"]); + #llvm_extractvalue{} -> + write(Dev, [extractvalue_dst(I), " = extractvalue "]), + pp_type(Dev, extractvalue_type(I)), + %% TODO Print idxs + write(Dev, [" ", extractvalue_val(I), ", ", extractvalue_idx(I), "\n"]); + #llvm_insertvalue{} -> + write(Dev, [insertvalue_dst(I), " = insertvalue "]), + pp_type(Dev, insertvalue_val_type(I)), + write(Dev, [" ", insertvalue_val(I), ", "]), + pp_type(Dev, insertvalue_elem_type(I)), + %%TODO Print idxs + write(Dev, [" ", insertvalue_elem(I), ", ", insertvalue_idx(I), "\n"]); + #llvm_alloca{} -> + write(Dev, [alloca_dst(I), " = alloca "]), + pp_type(Dev, alloca_type(I)), + case alloca_num(I) of + [] -> ok; + Num -> + write(Dev, ", "), + pp_type(Dev, alloca_type(I)), + write(Dev, [" ", Num, " "]) + end, + case alloca_align(I) of + [] -> ok; + Align -> write(Dev, [",align ", Align]) + end, + write(Dev, "\n"); + #llvm_load{} -> + write(Dev, [load_dst(I), " = "]), + write(Dev, "load "), + case load_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_type(Dev, load_p_type(I)), + write(Dev, [" ", load_pointer(I), " "]), + case load_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case load_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_store{} -> + write(Dev, "store "), + case store_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_type(Dev, store_type(I)), + write(Dev, [" ", store_value(I), ", "]), + pp_type(Dev, store_p_type(I)), + write(Dev, [" ", store_pointer(I), " "]), + case store_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case store_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_getelementptr{} -> + write(Dev, [getelementptr_dst(I), " = getelementptr "]), + case getelementptr_inbounds(I) of + true -> write(Dev, "inbounds "); + false -> ok + end, + pp_type(Dev, getelementptr_p_type(I)), + write(Dev, [" ", getelementptr_value(I)]), + pp_typed_idxs(Dev, getelementptr_typed_idxs(I)), + write(Dev, "\n"); + #llvm_conversion{} -> + write(Dev, [conversion_dst(I), " = ", atom_to_list(conversion_op(I)), " "]), + pp_type(Dev, conversion_src_type(I)), + write(Dev, [" ", conversion_src(I), " to "]), + pp_type(Dev, conversion_dst_type(I)), + write(Dev, "\n"); + #llvm_icmp{} -> + write(Dev, [icmp_dst(I), " = icmp ", atom_to_list(icmp_cond(I)), " "]), + pp_type(Dev, icmp_type(I)), + write(Dev, [" ", icmp_src1(I), ", ", icmp_src2(I), "\n"]); + #llvm_fcmp{} -> + write(Dev, [fcmp_dst(I), " = fcmp ", atom_to_list(fcmp_cond(I)), " "]), + pp_type(Dev, fcmp_type(I)), + write(Dev, [" ", fcmp_src1(I), ", ", fcmp_src2(I), "\n"]); + #llvm_phi{} -> + write(Dev, [phi_dst(I), " = phi "]), + pp_type(Dev, phi_type(I)), + pp_phi_value_labels(Dev, phi_value_label_list(I)), + write(Dev, "\n"); + #llvm_select{} -> + write(Dev, [select_dst(I), " = select i1 ", select_cond(I), ", "]), + pp_type(Dev, select_typ1(I)), + write(Dev, [" ", select_val1(I), ", "]), + pp_type(Dev, select_typ2(I)), + write(Dev, [" ", select_val2(I), "\n"]); + #llvm_call{} -> + case call_dst(I) of + [] -> ok; + Dst -> write(Dev, [Dst, " = "]) + end, + case call_is_tail(I) of + true -> write(Dev, "tail "); + false -> ok + end, + write(Dev, ["call ", call_cconv(I), " "]), + pp_options(Dev, call_ret_attrs(I)), + pp_type(Dev, call_type(I)), + write(Dev, [" ", call_fnptrval(I), "("]), + pp_args(Dev, call_arglist(I)), + write(Dev, ") "), + pp_options(Dev, call_fn_attrs(I)), + write(Dev, "\n"); + #llvm_fun_def{} -> + write(Dev, "define "), + pp_options(Dev, fun_def_linkage(I)), + pp_options(Dev, fun_def_visibility(I)), + case fun_def_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_def_ret_attrs(I)), + write(Dev, " "), + pp_type(Dev, fun_def_type(I)), + write(Dev, [" @", fun_def_name(I), "("]), + pp_args(Dev, fun_def_arglist(I)), + write(Dev, ") "), + pp_options(Dev, fun_def_fn_attrs(I)), + case fun_def_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "{\n"), + pp_ins_list(Dev, fun_def_body(I)), + write(Dev, "}\n"); + #llvm_fun_decl{} -> + write(Dev, "declare "), + pp_options(Dev, fun_decl_linkage(I)), + pp_options(Dev, fun_decl_visibility(I)), + case fun_decl_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_decl_ret_attrs(I)), + pp_type(Dev, fun_decl_type(I)), + write(Dev, [" ", fun_decl_name(I), "("]), + pp_type_list(Dev, fun_decl_arglist(I)), + write(Dev, ") "), + case fun_decl_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "\n"); + #llvm_comment{} -> + write(Dev, ["; ", atom_to_list(comment_text(I)), "\n"]); + #llvm_label{} -> + write(Dev, [label_label(I), ":\n"]); + #llvm_const_decl{} -> + write(Dev, [const_decl_dst(I), " = ", const_decl_decl_type(I), " "]), + pp_type(Dev, const_decl_type(I)), + write(Dev, [" ", const_decl_value(I), "\n"]); + #llvm_landingpad{} -> + write(Dev, "landingpad { i8*, i32 } personality i32 (i32, i64, i8*,i8*)* + @__gcc_personality_v0 cleanup\n"); + #llvm_asm{} -> + write(Dev, [asm_instruction(I), "\n"]); + #llvm_adj_stack{} -> + write(Dev, ["call void asm sideeffect \"sub $0, ", + adj_stack_register(I), "\", \"r\"("]), + pp_type(Dev, adj_stack_type(I)), + write(Dev, [" ", adj_stack_offset(I),")\n"]); + #llvm_branch_meta{} -> + write(Dev, ["!", branch_meta_id(I), " = metadata !{metadata !\"branch_weights\", + i32 ", branch_meta_true_weight(I), ", i32 ", + branch_meta_false_weight(I), "}\n"]); + Other -> + exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}}) + end. + +%% @doc Pretty-print a list of types +pp_type_list(_Dev, []) -> ok; +pp_type_list(Dev, [T]) -> + pp_type(Dev, T); +pp_type_list(Dev, [T|Ts]) -> + pp_type(Dev, T), + write(Dev, ", "), + pp_type_list(Dev, Ts). + +pp_type(Dev, Type) -> + case Type of + #llvm_void{} -> + write(Dev, "void"); + #llvm_label_type{} -> + write(Dev, "label"); + %% Integer + #llvm_int{} -> + write(Dev, ["i", integer_to_list(int_width(Type))]); + %% Float + #llvm_float{} -> + write(Dev, "float"); + #llvm_double{} -> + write(Dev, "double"); + #llvm_fp80{} -> + write(Dev, "x86_fp80"); + #llvm_fp128{} -> + write(Dev, "fp128"); + #llvm_ppc_fp128{} -> + write(Dev, "ppc_fp128"); + %% Pointer + #llvm_pointer{} -> + pp_type(Dev, pointer_type(Type)), + write(Dev, "*"); + %% Function + #llvm_fun{} -> + pp_type(Dev, function_ret_type(Type)), + write(Dev, " ("), + pp_type_list(Dev, function_arg_type_list(Type)), + write(Dev, ")"); + %% Aggregate + #llvm_array{} -> + write(Dev, ["[", integer_to_list(array_size(Type)), " x "]), + pp_type(Dev, array_type(Type)), + write(Dev, "]"); + #llvm_struct{} -> + write(Dev, "{"), + pp_type_list(Dev, struct_type_list(Type)), + write(Dev, "}"); + #llvm_vector{} -> + write(Dev, ["{", integer_to_list(vector_size(Type)), " x "]), + pp_type(Dev, vector_type(Type)), + write(Dev, "}") + end. + +%% @doc Pretty-print a list of typed arguments +pp_args(_Dev, []) -> ok; +pp_args(Dev, [{Type, Arg} | []]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg]); +pp_args(Dev, [{Type, Arg} | Args]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg, ", "]), + pp_args(Dev, Args). + +%% @doc Pretty-print a list of options +pp_options(_Dev, []) -> ok; +pp_options(Dev, [O|Os]) -> + write(Dev, [atom_to_list(O), " "]), + pp_options(Dev, Os). + +%% @doc Pretty-print a list of phi value-labels +pp_phi_value_labels(_Dev, []) -> ok; +pp_phi_value_labels(Dev, [{Value, Label}|[]]) -> + write(Dev, ["[ ", Value, ", ", Label, " ]"]); +pp_phi_value_labels(Dev,[{Value, Label}|VL]) -> + write(Dev, ["[ ", Value, ", ", Label, " ], "]), + pp_phi_value_labels(Dev, VL). + +%% @doc Pretty-print a list of typed indexes +pp_typed_idxs(_Dev, []) -> ok; +pp_typed_idxs(Dev, [{Type, Id} | Tids]) -> + write(Dev, ", "), + pp_type(Dev, Type), + write(Dev, [" ", Id]), + pp_typed_idxs(Dev, Tids). + +%% @doc Pretty-print a switch label list +pp_switch_value_label_list(_Dev, _Type, []) -> ok; +pp_switch_value_label_list(Dev, Type, [{Value, Label} | VLs]) -> + write(Dev, " "), + pp_type(Dev, Type), + write(Dev, [" ", Value, ", label ", Label, "\n"]), + pp_switch_value_label_list(Dev, Type, VLs). + +%%---------------------------------------------------------------------------- +%% Auxiliary Functions +%%---------------------------------------------------------------------------- + +%% @doc Returns if an instruction needs to be intended +indent(I) -> + case I of + #llvm_label{} -> false; + #llvm_fun_def{} -> false; + #llvm_fun_decl{} -> false; + #llvm_const_decl{} -> false; + #llvm_branch_meta{} -> false; + _ -> true + end. + +op_has_options(Op) -> + case Op of + 'and' -> false; + 'or' -> false; + 'xor' -> false; + _ -> true + end. + +%% @doc Abstracts actual writing to file operations +write(Dev, Msg) -> + ok = file:write(Dev, Msg). diff --git a/lib/hipe/llvm/hipe_llvm_arch.hrl b/lib/hipe/llvm/hipe_llvm_arch.hrl new file mode 100644 index 0000000000..689a5a52ea --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_arch.hrl @@ -0,0 +1,11 @@ +-ifdef(BIT32). +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 3). +-define(ARCH_REGISTERS, hipe_x86_registers). +-define(FLOAT_OFFSET, 2). +-else. +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 4). +-define(ARCH_REGISTERS, hipe_amd64_registers). +-define(FLOAT_OFFSET, 6). +-endif. diff --git a/lib/hipe/llvm/hipe_llvm_liveness.erl b/lib/hipe/llvm/hipe_llvm_liveness.erl new file mode 100644 index 0000000000..d1c90ed4c9 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_liveness.erl @@ -0,0 +1,112 @@ +-module(hipe_llvm_liveness). + +-export([analyze/1]). + +%% @doc Find gc roots and explicitly mark when they go out of scope, based +%% on the liveness analyzis performed by the hipe_rtl_liveness:analyze/1. +analyze(RtlCfg) -> + Liveness = hipe_rtl_liveness:analyze(RtlCfg), + Roots = find_roots(RtlCfg, Liveness), + %% erlang:display(Roots), + NewRtlCfg = mark_dead_roots(RtlCfg, Liveness, Roots), + {NewRtlCfg, Roots}. + +%% @doc Determine which are the GC Roots.Possible roots are all +%% RTL variables (rtl_var). However, since safe points are function calls, we +%% consider as possible GC roots only RTL variables that are live around +%% function calls. +find_roots(Cfg, Liveness) -> + Labels = hipe_rtl_cfg:postorder(Cfg), + Roots = find_roots_bb(Labels, Cfg, Liveness, []), + lists:usort(lists:flatten(Roots)). + +find_roots_bb([], _Cfg, _Liveness, RootAcc) -> + RootAcc; +find_roots_bb([L|Ls], Cfg, Liveness, RootAcc) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveIn = ordsets:from_list(strip(hipe_rtl_liveness:livein(Liveness, L))), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + Roots = do_find_roots_bb(BlockCode, L, LiveOut, LiveIn, []), + find_roots_bb(Ls, Cfg, Liveness, Roots++RootAcc). + +%% For each call inside a BB the GC roots are those RTL variables that +%% are live before and after the call. +%% --> Live Before Call: These are the RTL variables that belong to the +%% LiveIn list or are initialized inside the BB before the call +%% --> Live After Call: These are the RTL variables that belong to the +%% LiveOut list or are used after the call inside the BB (they die +%% inside the BB and so do not belong to the LiveOut list) +do_find_roots_bb([], _Label, _LiveOut, _LiveBefore, RootAcc) -> + RootAcc; +do_find_roots_bb([I|Is], L, LiveOut, LiveBefore, RootAcc) -> + case hipe_rtl:is_call(I) of + true -> + %% Used inside the BB after the call + UsedAfterCall_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfterCall = ordsets:from_list(UsedAfterCall_), + LiveAfter = ordsets:union(UsedAfterCall, LiveOut), + %% The Actual Roots + Roots = ordsets:intersection(LiveBefore, LiveAfter), + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, [Roots|RootAcc]); + false -> + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, RootAcc) + end. + +%% @doc This function is responsible for marking when GC Roots, which can be +%% only RTL variables go out of scope (dead). This pass is needed for the LLVM +%% back end because the LLVM framework forces us to explicit mark when gc roots +%% are no longer live. +mark_dead_roots(CFG, Liveness, Roots) -> + Labels = hipe_rtl_cfg:postorder(CFG), + mark_dead_bb(Labels, CFG, Liveness, Roots). + +mark_dead_bb([], Cfg, _Liveness, _Roots) -> + Cfg; +mark_dead_bb([L|Ls], Cfg, Liveness, Roots) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + NewBlockCode = do_mark_dead_bb(BlockCode, LiveOut, Roots, []), + %% Update the CFG + NewBB = hipe_bb:code_update(Block, NewBlockCode), + NewCFG = hipe_rtl_cfg:bb_add(Cfg, L, NewBB), + mark_dead_bb(Ls, NewCFG, Liveness, Roots). + +do_mark_dead_bb([], _LiveOut, _Roots, NewBlockCode) -> + lists:reverse(NewBlockCode); +do_mark_dead_bb([I|Is], LiveOut ,Roots, NewBlockCode) -> + Uses = ordsets:from_list(strip(hipe_rtl:uses(I))), + %% GC roots that are used in this instruction + RootsUsed = ordsets:intersection(Roots, Uses), + UsedAfter_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfter = ordsets:from_list(UsedAfter_), + %% GC roots that are live after this instruction + LiveAfter = ordsets:union(LiveOut, UsedAfter), + %% GC roots that their last use is in this instruction + DeadRoots = ordsets:subtract(RootsUsed, LiveAfter), + %% Recreate the RTL variable from the corresponding Index + OldVars = [hipe_rtl:mk_var(V1) || V1 <- DeadRoots], + %% Mark the RTL variable as DEAD (last use) + NewVars = [kill_var(V2) || V2 <- OldVars], + %% Create a list with the substitution of the old vars with the new + %% ones which are marked with the dead keyword + Subtitution = lists:zip(OldVars, NewVars), + NewI = case Subtitution of + [] -> I; + _ -> hipe_rtl:subst_uses_llvm(Subtitution, I) + end, + do_mark_dead_bb(Is, LiveOut, Roots, [NewI|NewBlockCode]). + +%% Update the liveness of a var,in order to mark that this is the last use. +kill_var(Var) -> hipe_rtl:var_liveness_update(Var, dead). + +%% We are only interested for rtl_vars, since only rtl_vars are possible gc +%% roots. +strip(L) -> [Y || {rtl_var, Y, _} <- L]. diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl new file mode 100644 index 0000000000..e911fb89c9 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -0,0 +1,514 @@ +%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_main). + +-export([rtl_to_native/4]). + +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("hipe_llvm_arch.hrl"). +-include("elf_format.hrl"). + +%% @doc Translation of RTL to a loadable object. This function takes the RTL +%% code and calls hipe_rtl_to_llvm:translate/2 to translate the RTL code to +%% LLVM code. After this, LLVM asm is printed to a file and the LLVM tool +%% chain is invoked in order to produce an object file. +rtl_to_native(MFA, RTL, Roots, Options) -> + %% Compile to LLVM and get Instruction List (along with infos) + {LLVMCode, RelocsDict, ConstTab} = + hipe_rtl_to_llvm:translate(RTL, Roots), + %% Fix function name to an acceptable LLVM identifier (needed for closures) + {_Module, Fun, Arity} = hipe_rtl_to_llvm:fix_mfa_name(MFA), + %% Write LLVM Assembly to intermediate file (on disk) + {ok, Dir, ObjectFile} = + compile_with_llvm(Fun, Arity, LLVMCode, Options, false), + %% + %% Extract information from object file + %% + ObjBin = open_object_file(ObjectFile), + %% Read and set the ELF class + elf_format:set_architecture_flag(ObjBin), + %% Get labels info (for switches and jump tables) + Labels = elf_format:get_rodata_relocs(ObjBin), + {Switches, Closures} = get_tables(ObjBin), + %% Associate Labels with Switches and Closures with stack args + {SwitchInfos, ExposedClosures} = + correlate_labels(Switches ++ Closures, Labels), + %% SwitchInfos: [{"table_50", [Labels]}] + %% ExposedClosures: [{"table_closures", [Labels]}] + + %% Labelmap contains the offsets of the labels in the code that are + %% used for switch's jump tables + LabelMap = create_labelmap(MFA, SwitchInfos, RelocsDict), + %% Get relocation info + TextRelocs = elf_format:get_text_relocs(ObjBin), + %% AccRefs contains the offsets of all references to relocatable symbols in + %% the code: + AccRefs = fix_relocations(TextRelocs, RelocsDict, MFA), + %% Get stack descriptors + SDescs = get_sdescs(ObjBin), + %% FixedSDescs are the stack descriptors after correcting calls that have + %% arguments in the stack + FixedSDescs = + fix_stack_descriptors(RelocsDict, AccRefs, SDescs, ExposedClosures), + Refs = AccRefs ++ FixedSDescs, + %% Get binary code from object file + BinCode = elf_format:extract_text(ObjBin), + %% Remove temp files (if needed) + ok = remove_temp_folder(Dir, Options), + %% Return the code together with information that will be used in the + %% hipe_llvm_merge module to produce the final binary that will be loaded + %% by the hipe unified loader. + {MFA, BinCode, byte_size(BinCode), ConstTab, Refs, LabelMap}. + +%%------------------------------------------------------------------------------ +%% LLVM tool chain +%%------------------------------------------------------------------------------ + +%% @doc Compile function FunName/Arity to LLVM. Return Dir (in order to remove +%% it if we do not want to store temporary files) and ObjectFile name that +%% is created by the LLVM tools. +compile_with_llvm(FunName, Arity, LLVMCode, Options, UseBuffer) -> + Filename = atom_to_list(FunName) ++ "_" ++ integer_to_list(Arity), + %% Save temp files in a unique folder + Dir = unique_folder(FunName, Arity, Options), + ok = file:make_dir(Dir), + %% Print LLVM assembly to file + OpenOpts = [append, raw] ++ + case UseBuffer of + %% true -> [delayed_write]; % Use delayed_write! + false -> [] + end, + {ok, File_llvm} = file:open(Dir ++ Filename ++ ".ll", OpenOpts), + hipe_llvm:pp_ins_list(File_llvm, LLVMCode), + %% delayed_write can cause file:close not to do a close, hence the two calls + ok = file:close(File_llvm), + __ = file:close(File_llvm), + %% Invoke LLVM compiler tools to produce an object file + llvm_opt(Dir, Filename, Options), + llvm_llc(Dir, Filename, Options), + compile(Dir, Filename, "gcc"), %%FIXME: use llc -filetype=obj and skip this! + {ok, Dir, Dir ++ Filename ++ ".o"}. + +%% @doc Invoke opt tool to optimize the bitcode (_name.ll -> _name.bc). +llvm_opt(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".ll", + Dest = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(opt, Options), + OptFlags = [OptLevel, "-mem2reg", "-strip"], + Command = "opt " ++ fix_opts(OptFlags) ++ " " ++ Source ++ " -o " ++ Dest, + %% io:format("OPT: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, opt, Error}) + end. + +%% @doc Invoke llc tool to compile the bitcode to object file +%% (_name.bc -> _name.o). +llvm_llc(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(llc, Options), + Align = find_stack_alignment(), + LlcFlags = [OptLevel, "-code-model=medium", "-stack-alignment=" ++ Align + , "-tailcallopt", "-filetype=asm"], %%FIXME + Command = "llc " ++ fix_opts(LlcFlags) ++ " " ++ Source, + %% io:format("LLC: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, llc, Error}) + end. + +%% @doc Invoke the compiler tool ("gcc", "llvmc", etc.) to generate an object +%% file from native assembly. +compile(Dir, Fun_Name, Compiler) -> + Source = Dir ++ Fun_Name ++ ".s", + Dest = Dir ++ Fun_Name ++ ".o", + Command = Compiler ++ " -c " ++ Source ++ " -o " ++ Dest, + %% io:format("~s: ~s~n", [Compiler, Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, cc, Error}) + end. + +find_stack_alignment() -> + case get(hipe_target_arch) of + x86 -> "4"; + amd64 -> "8"; + _ -> exit({?MODULE, find_stack_alignment, "Unimplemented architecture"}) + end. + +%% @doc Join options. +fix_opts(Opts) -> + string:join(Opts, " "). + +%% @doc Translate optimization-level flag (default is "O2"). +trans_optlev_flag(Tool, Options) -> + Flag = case Tool of + opt -> llvm_opt; + llc -> llvm_llc + end, + case proplists:get_value(Flag, Options) of + o0 -> ""; % "-O0" does not exist in opt tool + o1 -> "-O1"; + o2 -> "-O2"; + o3 -> "-O3"; + undefined -> "-O2" + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Relocations +%%------------------------------------------------------------------------------ + +%% @doc Get switch table and closure table. +get_tables(Elf) -> + %% Search Symbol Table for an entry with name prefixed with "table_": + Triples = elf_format:get_tab_entries(Elf), + Switches = [T || T={"table_" ++ _, _, _} <- Triples], + Closures = [T || T={"table_closures" ++ _, _, _} <- Switches], + {Switches, Closures}. + +%% @doc This function associates symbols who point to some table of labels with +%% the corresponding offsets of the labels in the code. These tables can +%% either be jump tables for switches or a table which contains the labels +%% of blocks that contain closure calls with more than ?NR_ARG_REGS. +correlate_labels([], _L) -> {[], []}; +correlate_labels(Tables, Labels) -> + %% Sort "Tables" based on "ValueOffsets" + OffsetSortedTb = lists:ukeysort(2, Tables), + %% Unzip offset-sorted list of "Switches" + {Names, _Offsets, TablesSizeList} = lists:unzip3(OffsetSortedTb), + %% Associate switch names with labels + L = split_list(Labels, TablesSizeList), + %% Zip back! (to [{SwitchName, Values}]) + NamesValues = lists:zip(Names, L), + case lists:keytake("table_closures", 1, NamesValues) of + false -> %% No closures in the code, no closure table + {NamesValues, []}; + {value, ClosureTableNV, SwitchesNV} -> + {SwitchesNV, ClosureTableNV} + end. + +%% @doc Create a gb_tree which contains information about the labels that used +%% for switch's jump tables. The keys of the gb_tree are of the form +%% {MFA, Label} and the values are the actual Offsets. +create_labelmap(MFA, SwitchInfos, RelocsDict) -> + create_labelmap(MFA, SwitchInfos, RelocsDict, gb_trees:empty()). + +create_labelmap(_, [], _, LabelMap) -> LabelMap; +create_labelmap(MFA, [{Name, Offsets} | Rest], RelocsDict, LabelMap) -> + case dict:fetch(Name, RelocsDict) of + {switch, {_TableType, LabelList, _NrLabels, _SortOrder}, _JTabLab} -> + KVDict = lists:ukeysort(1, lists:zip(LabelList, Offsets)), + NewLabelMap = insert_to_labelmap(KVDict, LabelMap), + create_labelmap(MFA, Rest, RelocsDict, NewLabelMap); + _ -> + exit({?MODULE, create_labelmap, "Not a jump table!"}) + end. + +%% @doc Insert a list of [{Key,Value}] to a LabelMap (gb_tree). +insert_to_labelmap([], LabelMap) -> LabelMap; +insert_to_labelmap([{Key, Value}|Rest], LabelMap) -> + case gb_trees:lookup(Key, LabelMap) of + none -> + insert_to_labelmap(Rest, gb_trees:insert(Key, Value, LabelMap)); + {value, Value} -> %% Exists with the *exact* same Value. + insert_to_labelmap(Rest, LabelMap) + end. + +%% @doc Correlate object file relocation symbols with info from translation to +%% llvm code. +fix_relocations(Relocs, RelocsDict, MFA) -> + fix_relocs(Relocs, RelocsDict, MFA, []). + +fix_relocs([], _, _, RelocAcc) -> RelocAcc; +fix_relocs([{Name, Offset}|Rs], RelocsDict, {ModName,_,_}=MFA, RelocAcc) -> + case dict:fetch(Name, RelocsDict) of + {atom, AtomName} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ATOM, Offset, AtomName}|RelocAcc]); + {constant, Label} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, {constant, Label}}|RelocAcc]); + {switch, _, JTabLab} -> %% Treat switch exactly as constant + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, {constant, JTabLab}}|RelocAcc]); + {closure, _}=Closure -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, Closure}|RelocAcc]); + {call, {bif, BifName, _}} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_LOCAL, Offset, BifName}|RelocAcc]); + %% MFA calls to functions in the same module are of type 3, while all + %% other MFA calls are of type 2. + {call, {ModName,_F,_A}=CallMFA} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_LOCAL, Offset, CallMFA}|RelocAcc]); + {call, CallMFA} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_REMOTE, Offset, CallMFA}|RelocAcc]); + Other -> + exit({?MODULE, fix_relocs, + {"Relocation not in relocation dictionary", Other}}) + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Stack Descriptors +%%------------------------------------------------------------------------------ + +%% @doc This function takes an ELF Object File binary and returns a proper sdesc +%% list for Erlang/OTP System's loader. The return value should be of the +%% form: +%% { +%% 4, Safepoint Address, +%% {ExnLabel OR [], FrameSize, StackArity, {Liveroot stack frame indexes}}, +%% } +get_sdescs(Elf) -> + case elf_format:extract_note(Elf, ?NOTE_ERLGC_NAME) of + <<>> -> % Object file has no ".note.gc" section! + []; + NoteGC_bin -> + %% Get safe point addresses (stored in ".rela.note.gc" section): + RelaNoteGC = elf_format:extract_rela(Elf, ?NOTE(?NOTE_ERLGC_NAME)), + SPCount = length(RelaNoteGC), + T = SPCount * ?SP_ADDR_SIZE, + %% Pattern match fields of ".note.gc": + <<SPCount:(?bits(?SP_COUNT_SIZE))/integer-little, % Sanity check! + SPAddrs:T/binary, % NOTE: In 64bit they are relocs! + StkFrameSize:(?bits(?SP_STKFRAME_SIZE))/integer-little, + StkArity:(?bits(?SP_STKARITY_SIZE))/integer-little, + _LiveRootCount:(?bits(?SP_LIVEROOTCNT_SIZE))/integer-little, % Skip + Roots/binary>> = NoteGC_bin, + LiveRoots = get_liveroots(Roots, []), + %% Extract information about the safe point addresses: + SPOffs = + case elf_format:is64bit() of + true -> %% Find offsets in ".rela.note.gc": + elf_format:get_rela_addends(RelaNoteGC); + false -> %% Find offsets in SPAddrs (in ".note.gc"): + get_spoffs(SPAddrs, []) + end, + %% Extract Exception Handler labels: + ExnHandlers = elf_format:get_exn_handlers(Elf), + %% Combine ExnHandlers and Safe point addresses (return addresses): + ExnAndSPOffs = combine_ras_and_exns(ExnHandlers, SPOffs, []), + create_sdesc_list(ExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, []) + end. + +%% @doc Extracts a bunch of integers (live roots) from a binary. Returns a tuple +%% as need for stack descriptors. +get_liveroots(<<>>, Acc) -> + list_to_tuple(Acc); +get_liveroots(<<Root:?bits(?LR_STKINDEX_SIZE)/integer-little, + MoreRoots/binary>>, Acc) -> + get_liveroots(MoreRoots, [Root | Acc]). + +%% @doc Extracts a bunch of integers (safepoint offsets) from a binary. Returns +%% a tuple as need for stack descriptors. +get_spoffs(<<>>, Acc) -> + lists:reverse(Acc); +get_spoffs(<<SPOff:?bits(?SP_ADDR_SIZE)/integer-little, More/binary>>, Acc) -> + get_spoffs(More, [SPOff | Acc]). + +combine_ras_and_exns(_, [], Acc) -> + lists:reverse(Acc); +combine_ras_and_exns(ExnHandlers, [RA | MoreRAs], Acc) -> + %% FIXME: do something better than O(n^2) by taking advantage of the property + %% ||ExnHandlers|| <= ||RAs|| + Handler = find_exn_handler(RA, ExnHandlers), + combine_ras_and_exns(ExnHandlers, MoreRAs, [{Handler, RA} | Acc]). + +find_exn_handler(_, []) -> + []; +find_exn_handler(RA, [{Start, End, Handler} | MoreExnHandlers]) -> + case (RA >= Start andalso RA =< End) of + true -> + Handler; + false -> + find_exn_handler(RA, MoreExnHandlers) + end. + +create_sdesc_list([], _, _, _, Acc) -> + lists:reverse(Acc); +create_sdesc_list([{ExnLbl, SPOff} | MoreExnAndSPOffs], + StkFrameSize, StkArity, LiveRoots, Acc) -> + Hdlr = case ExnLbl of + 0 -> []; + N -> N + end, + create_sdesc_list(MoreExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, + [{?SDESC, SPOff, {Hdlr, StkFrameSize, StkArity, LiveRoots}} + | Acc]). + +%% @doc This function is responsible for correcting the stack descriptors of +%% the calls that are found in the code and have more than NR_ARG_REGS +%% (thus, some of their arguments are passed to the stack). Because of the +%% Reserved Call Frame feature that the LLVM uses, the stack descriptors +%% are not correct since at the point of call the frame size is reduced +%% proportionally to the number of arguments that are passed on the stack. +%% Also the offsets of the roots need to be re-adjusted. +fix_stack_descriptors(_, _, [], _) -> + []; +fix_stack_descriptors(RelocsDict, Relocs, SDescs, ExposedClosures) -> + %% NamedCalls are MFA and BIF calls that need fix + NamedCalls = calls_with_stack_args(RelocsDict), + NamedCallsOffs = calls_offsets_arity(Relocs, NamedCalls), + ExposedClosures1 = + case dict:is_key("table_closures", RelocsDict) of + true -> %% A Table with closures exists + {table_closures, ArityList} = dict:fetch("table_closures", RelocsDict), + case ExposedClosures of + {_, Offsets} -> + lists:zip(Offsets, ArityList); + _ -> + exit({?MODULE, fix_stack_descriptors, + {"Wrong exposed closures", ExposedClosures}}) + end; + false -> + [] + end, + ClosuresOffs = closures_offsets_arity(ExposedClosures1, SDescs), + fix_sdescs(NamedCallsOffs ++ ClosuresOffs, SDescs). + +%% @doc This function takes as argument the relocation dictionary as produced by +%% the translation of RTL code to LLVM and finds the names of the calls +%% (MFA and BIF calls) that have more than NR_ARG_REGS. +calls_with_stack_args(Dict) -> + calls_with_stack_args(dict:to_list(Dict), []). + +calls_with_stack_args([], Calls) -> Calls; +calls_with_stack_args([ {_Name, {call, {M, F, A}}} | Rest], Calls) + when A > ?NR_ARG_REGS -> + Call = + case M of + bif -> {F,A}; + _ -> {M,F,A} + end, + calls_with_stack_args(Rest, [Call|Calls]); +calls_with_stack_args([_|Rest], Calls) -> + calls_with_stack_args(Rest, Calls). + +%% @doc This function extracts the stack arity and the offset in the code of +%% the named calls (MFAs, BIFs) that have stack arguments. +calls_offsets_arity(AccRefs, CallsWithStackArgs) -> + calls_offsets_arity(AccRefs, CallsWithStackArgs, []). + +calls_offsets_arity([], _, Acc) -> Acc; +calls_offsets_arity([{Type, Offset, Term} | Rest], CallsWithStackArgs, Acc) + when Type =:= ?CALL_REMOTE orelse Type =:= ?CALL_LOCAL -> + case lists:member(Term, CallsWithStackArgs) of + true -> + Arity = + case Term of + {_M, _F, A} -> A; + {_F, A} -> A + end, + calls_offsets_arity(Rest, CallsWithStackArgs, + [{Offset + 4, Arity - ?NR_ARG_REGS} | Acc]); + false -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc) + end; +calls_offsets_arity([_|Rest], CallsWithStackArgs, Acc) -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc). + +%% @doc This function extracts the stack arity and the offsets of closures that +%% have stack arity. The Closures argument represents the +%% hipe_bifs:llvm_exposure_closure/0 calls in the code. The actual closure +%% is the next call in the code, so the offset of the next call must be +%% calculated from the stack descriptors. +closures_offsets_arity([], _) -> + []; +closures_offsets_arity(ExposedClosures, SDescs) -> + Offsets = [Offset || {_, Offset, _} <- SDescs], + %% Offsets and closures must be sorted in order for find_offsets/3 to work + SortedOffsets = lists:sort(Offsets), + SortedExposedClosures = lists:keysort(1, ExposedClosures), + find_offsets(SortedExposedClosures, SortedOffsets, []). + +find_offsets([], _, Acc) -> Acc; +find_offsets([{Off,Arity}|Rest], Offsets, Acc) -> + [I | RestOffsets] = lists:dropwhile(fun (Y) -> Y<Off end, Offsets), + find_offsets(Rest, RestOffsets, [{I, Arity}|Acc]). + +%% The functions below correct the arity of calls, that are identified +%% by offset, in the stack descriptors. +fix_sdescs([], SDescs) -> SDescs; +fix_sdescs([{Offset, Arity} | Rest], SDescs) -> + case lists:keyfind(Offset, 2, SDescs) of + false -> + fix_sdescs(Rest, SDescs); + {?SDESC, Offset, SDesc} -> + {ExnHandler, FrameSize, StkArity, Roots} = SDesc, + DecRoot = fun(X) -> X-Arity end, + NewRootsList = lists:map(DecRoot, tuple_to_list(Roots)), + NewSDesc = + case length(NewRootsList) > 0 andalso hd(NewRootsList) >= 0 of + true -> + {?SDESC, Offset, {ExnHandler, FrameSize-Arity, StkArity, + list_to_tuple(NewRootsList)}}; + false -> + {?SDESC, Offset, {ExnHandler, FrameSize, StkArity, Roots}} + end, + RestSDescs = lists:keydelete(Offset, 2, SDescs), + fix_sdescs(Rest, [NewSDesc | RestSDescs]) + end. + + +%%------------------------------------------------------------------------------ +%% Miscellaneous functions +%%------------------------------------------------------------------------------ + +%% @doc A function that opens a file as binary. The function takes as argument +%% the name of the file and returns an Erlang binary. +-spec open_object_file(string()) -> binary(). +open_object_file(ObjFile) -> + case file:read_file(ObjFile) of + {ok, Binary} -> + Binary; + {error, Reason} -> + exit({?MODULE, open_file, Reason}) + end. + +remove_temp_folder(Dir, Options) -> + case proplists:get_bool(llvm_save_temps, Options) of + true -> ok; + false -> spawn(fun () -> "" = os:cmd("rm -rf " ++ Dir) end), ok + end. + +unique_id(FunName, Arity) -> + integer_to_list(erlang:phash2({FunName, Arity, now()})). + +unique_folder(FunName, Arity, Options) -> + DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/", + Dir = + case proplists:get_bool(llvm_save_temps, Options) of + true -> %% Store folder in current directory + DirName; + false -> %% Temporarily store folder in tempfs (/dev/shm/) + "/dev/shm/" ++ DirName + end, + %% Make sure it does not exist + case dir_exists(Dir) of + true -> %% Dir already exists! Generate again. + unique_folder(FunName, Arity, Options); + false -> + Dir + end. + +%% @doc Function that checks that a given Filename is an existing Directory +%% Name (from http://rosettacode.org/wiki/Ensure_that_a_file_exists#Erlang) +dir_exists(Filename) -> + {Flag, Info} = file:read_file_info(Filename), + (Flag =:= ok) andalso (element(3, Info) =:= directory). + +%% @doc Function that takes as arguments a list of integers and a list with +%% numbers indicating how many items should each tuple have and splits +%% the original list to a list of lists of integers (with the specified +%% number of elements), i.e. [ [...], [...] ]. +-spec split_list([integer()], [integer()]) -> [ [integer()] ]. +split_list(List, ElemsPerTuple) -> + split_list(List, ElemsPerTuple, []). + +-spec split_list([integer()], [integer()], [ [integer()] ]) -> [ [integer()] ]. +split_list([], [], Acc) -> + lists:reverse(Acc); +split_list(List, [NumOfElems | MoreNums], Acc) -> + {L1, L2} = lists:split(NumOfElems, List), + split_list(L2, MoreNums, [ L1 | Acc]). diff --git a/lib/hipe/llvm/hipe_llvm_merge.erl b/lib/hipe/llvm/hipe_llvm_merge.erl new file mode 100644 index 0000000000..3ababfc21a --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_merge.erl @@ -0,0 +1,114 @@ +%%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_merge). + +-export([finalize/3]). + +-include("hipe_llvm_arch.hrl"). +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("../main/hipe.hrl"). + +finalize(CompiledCode, Closures, Exports) -> + CompiledCode1 = [CodePack || {_, CodePack} <- CompiledCode], + Code = [{MFA, [], ConstTab} + || {MFA, _, _ , ConstTab, _, _} <- CompiledCode1], + {ConstAlign, ConstSize, ConstMap, RefsFromConsts} = + hipe_pack_constants:pack_constants(Code, ?ARCH_REGISTERS:alignment()), + %% Compute total code size separately as a sanity check for alignment + CodeSize = compute_code_size(CompiledCode1, 0), + %% io:format("Code Size (pre-computed): ~w~n", [CodeSize]), + {CodeBinary, ExportMap} = merge_mfas(CompiledCode1, 0, <<>>, []), + %% io:format("Code Size (post-computed): ~w~n", [byte_size(CodeBinary)]), + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + AccRefs = merge_refs(CompiledCode1, ConstMap, 0, []), + %% Bring CompiledCode to a combine_label_maps-acceptable form. + LabelMap = combine_label_maps(CompiledCode1, 0, gb_trees:empty()), + SC = hipe_pack_constants:slim_constmap(ConstMap), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap, Closures, Exports), + SlimRefs = hipe_pack_constants:slim_refs(AccRefs), + term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + ConstAlign, ConstSize, + SC, % ConstMap + DataRelocs, % LabelMap + SSE, % ExportMap + CodeSize, CodeBinary, SlimRefs, + 0,[] % ColdCodeSize, SlimColdRefs + ]). + +%% Copied from hipe_x86_assemble.erl +nr_pad_bytes(Address) -> + (4 - (Address rem 4)) rem 4. % XXX: 16 or 32 instead? + +align_entry(Address) -> + Address + nr_pad_bytes(Address). + +compute_code_size([{_MFA, _BinaryCode, CodeSize, _, _, _}|Code], Size) -> + compute_code_size(Code, align_entry(Size+CodeSize)); +compute_code_size([], Size) -> Size. + +combine_label_maps([{MFA, _, CodeSize, _, _, LabelMap}|Code], Address, CLM) -> + NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM), + combine_label_maps(Code, align_entry(Address+CodeSize), NewCLM); +combine_label_maps([], _Address, CLM) -> CLM. + +merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) -> + NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM), + merge_label_map(Rest, MFA, Address, NewCLM); +merge_label_map([], _MFA, _Address, CLM) -> CLM. + +%% @doc Merge the MFAs' binary code to one continuous binary and compute the +%% size of this binary. At the same time create an exportmap in a form +%% of {Address, M, F, A}. +%% XXX: Is alignment correct/optimal for X86/AMD64? +merge_mfas([{{M,F,A}, CodeBinary, CodeSize, _, _, _}|Code], + Address, AccCode, AccExportMap) -> + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + {Address1, Code1} = + case nr_pad_bytes(Address + CodeSize) of + 0 -> %% Retains alignment: + {Address + CodeSize, CodeBinary}; + NrPadBytes -> %% Needs padding! + Padding = list_to_binary(lists:duplicate(NrPadBytes, 0)), + {Address + CodeSize + NrPadBytes, % =:= align_entry(Address+CodeSize) + <<CodeBinary/binary, Padding/binary>>} + end, + ?VERBOSE_ASSERT(Address1 =:= + align_entry(Address + CodeSize)), %XXX: Should address be aligned? + AccCode1 = <<AccCode/binary, Code1/binary>>, + merge_mfas(Code, Address1, AccCode1, [{Address, M, F, A}|AccExportMap]); +merge_mfas([], _Address, AccCode, AccExportMap) -> + {AccCode, AccExportMap}. + +%% @doc Merge the references of relocatable symbols in the binary code. The +%% offsets must be updated because of the merging of the code binaries! +merge_refs([], _ConstMap, _Addr, AccRefs) -> AccRefs; +merge_refs([{MFA, _, CodeSize, _, Refs, _}|Rest], ConstMap, Address, AccRefs) -> + %% Important!: The hipe_pack_constants:pack_constants/2 function assignes + %% unique numbers to constants (ConstNo). This numbers are used from now on, + %% instead of labels that were used before. So, in order to be compatible, we + %% must change all the constant labels in the Refs to the corresponding + %% ConstNo, that can be found in the ConstMap (#pcm_entry{}). + UpdatedRefs = [update_ref(label_to_constno(Ref, MFA, ConstMap), Address) + || Ref <- Refs], + merge_refs(Rest, ConstMap, align_entry(Address+CodeSize), + UpdatedRefs++AccRefs). + +label_to_constno({Type, Offset, {constant, Label}}, MFA, ConstMap) -> + ConstNo = hipe_pack_constants:find_const({MFA, Label}, ConstMap), + {Type, Offset, {constant, ConstNo}}; +label_to_constno(Other, _MFA, _ConstMap) -> + Other. + +%% @doc Update offset to a reference. In case of stack descriptors we must check +%% if there exists an exception handler, because it must also be updated. +update_ref({?SDESC, Offset, SDesc}, CodeAddr) -> + NewRefAddr = Offset+CodeAddr, + case SDesc of + {[], _, _, _} -> % No handler; only update offset + {?SDESC, NewRefAddr, SDesc}; + {ExnHandler, FrameSize, StackArity, Roots} -> % Update exception handler + {?SDESC, NewRefAddr, {ExnHandler+CodeAddr, FrameSize, StackArity, Roots}} + end; +update_ref({Type, Offset, Term}, CodeAddr) -> + {Type, Offset+CodeAddr, Term}. diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl new file mode 100644 index 0000000000..ba76e1d815 --- /dev/null +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -0,0 +1,1612 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_rtl_to_llvm). +-author("Chris Stavrakakis, Yiannis Tsiouris"). + +-export([translate/2]). % the main function of this module +-export([fix_mfa_name/1]). % a help function used in hipe_llvm_main + +-include("../rtl/hipe_rtl.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("hipe_llvm_arch.hrl"). + +-define(WORD_WIDTH, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BRANCH_META_TAKEN, "0"). +-define(BRANCH_META_NOT_TAKEN, "1"). + +%%------------------------------------------------------------------------------ +%% @doc Main function for translating an RTL function to LLVM Assembly. Takes as +%% input the RTL code and the variable indexes of possible garbage +%% collection roots and returns the corresponing LLVM, a dictionary with +%% all the relocations in the code and a hipe_consttab() with informaton +%% about data. +%%------------------------------------------------------------------------------ +translate(RTL, Roots) -> + Fun = hipe_rtl:rtl_fun(RTL), + Params = hipe_rtl:rtl_params(RTL), + Data = hipe_rtl:rtl_data(RTL), + Code = hipe_rtl:rtl_code(RTL), + %% Init unique symbol generator and initialize the label counter to the last + %% RTL label. + hipe_gensym:init(llvm), + {_, MaxLabel} = hipe_rtl:rtl_label_range(RTL), + put({llvm,label_count}, MaxLabel + 1), + %% Put first label of RTL code in process dictionary + find_code_entry_label(Code), + %% Initialize relocations symbol dictionary + Relocs = dict:new(), + %% Print RTL to file + %% {ok, File_rtl} = file:open("rtl_" ++integer_to_list(random:uniform(2000)) + %% ++ ".rtl", [write]), + %% hipe_rtl:pp(File_rtl, RTL), + %% file:close(File_rtl), + + %% Pass on RTL code to handle exception handling and identify labels of Fail + %% Blocks + {Code1, FailLabels} = fix_code(Code), + %% Allocate stack slots for each virtual register and declare gc roots + AllocaStackCode = alloca_stack(Code1, Params, Roots), + %% Translate Code + {LLVM_Code1, Relocs1, NewData} = + translate_instr_list(Code1, [], Relocs, Data), + %% Create LLVM code to declare relocation symbols as external symbols along + %% with local variables in order to use them as just any other variable + {FinalRelocs, ExternalDecl, LocalVars} = + handle_relocations(Relocs1, Data, Fun), + %% Pass on LLVM code in order to create Fail blocks and a landingpad + %% instruction to each one + LLVM_Code2 = add_landingpads(LLVM_Code1, FailLabels), + %% Create LLVM Code for the compiled function + LLVM_Code3 = create_function_definition(Fun, Params, LLVM_Code2, + AllocaStackCode ++ LocalVars), + %% Final Code = CompiledFunction + External Declarations + FinalLLVMCode = [LLVM_Code3 | ExternalDecl], + {FinalLLVMCode, FinalRelocs, NewData}. + +find_code_entry_label([]) -> + exit({?MODULE, find_code_entry_label, "Empty code"}); +find_code_entry_label([I|_]) -> + case hipe_rtl:is_label(I) of + true -> + put(first_label, hipe_rtl:label_name(I)); + false -> + exit({?MODULE, find_code_entry_label, "First instruction is not a label"}) + end. + +%% @doc Create a stack slot for each virtual register. The stack slots +%% that correspond to possible garbage collection roots must be +%% marked as such. +alloca_stack(Code, Params, Roots) -> + %% Find all assigned virtual registers + Destinations = collect_destinations(Code), + %% Declare virtual registers, and declare garbage collection roots + do_alloca_stack(Destinations++Params, Params, Roots). + +collect_destinations(Code) -> + lists:usort(lists:flatmap(fun insn_dst/1, Code)). + +do_alloca_stack(Destinations, Params, Roots) -> + do_alloca_stack(Destinations, Params, Roots, []). + +do_alloca_stack([], _, _, Acc) -> + Acc; +do_alloca_stack([D|Ds], Params, Roots, Acc) -> + {Name, _I} = trans_dst(D), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + case hipe_rtl:is_var(D) of + true -> + Num = hipe_rtl:var_index(D), + I1 = hipe_llvm:mk_alloca(Name, WordTy, [], []), + case lists:member(Num, Roots) of + true -> %% Variable is a possible Root + T1 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I2 = + hipe_llvm:mk_conversion(T1, bitcast, WordTyPtr, Name, BYTE_TYPE_PP), + GcRootArgs = [{BYTE_TYPE_PP, T1}, {ByteTyPtr, "@gc_metadata"}], + I3 = hipe_llvm:mk_call([], false, [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", GcRootArgs, []), + I4 = case lists:member(D, Params) of + false -> + hipe_llvm:mk_store(WordTy, "-5", WordTyPtr, Name, + [], [], false); + true -> [] + end, + do_alloca_stack(Ds, Params, Roots, [I1, I2, I3, I4 | Acc]); + false -> + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end; + false -> + case hipe_rtl:is_reg(D) andalso isPrecoloured(D) of + true -> %% Precoloured registers are mapped to "special" stack slots + do_alloca_stack(Ds, Params, Roots, Acc); + false -> + I1 = case hipe_rtl:is_fpreg(D) of + true -> + FloatTy = hipe_llvm:mk_double(), + hipe_llvm:mk_alloca(Name, FloatTy, [], []); + false -> hipe_llvm:mk_alloca(Name, WordTy, [], []) + end, + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end + end. + +%%------------------------------------------------------------------------------ +%% @doc Translation of the linearized RTL Code. Each RTL instruction is +%% translated to a list of LLVM Assembly instructions. The relocation +%% dictionary is updated when needed. +%%------------------------------------------------------------------------------ +translate_instr_list([], Acc, Relocs, Data) -> + {lists:reverse(lists:flatten(Acc)), Relocs, Data}; +translate_instr_list([I | Is], Acc, Relocs, Data) -> + {Acc1, NewRelocs, NewData} = translate_instr(I, Relocs, Data), + translate_instr_list(Is, [Acc1 | Acc], NewRelocs, NewData). + +translate_instr(I, Relocs, Data) -> + case I of + #alu{} -> + {I2, Relocs2} = trans_alu(I, Relocs), + {I2, Relocs2, Data}; + #alub{} -> + {I2, Relocs2} = trans_alub(I, Relocs), + {I2, Relocs2, Data}; + #branch{} -> + {I2, Relocs2} = trans_branch(I, Relocs), + {I2, Relocs2, Data}; + #call{} -> + {I2, Relocs2} = + case hipe_rtl:call_fun(I) of + %% In AMD64 this instruction does nothing! + %% TODO: chech use of fwait in other architectures! + fwait -> + {[], Relocs}; + _ -> + trans_call(I, Relocs) + end, + {I2, Relocs2, Data}; + #comment{} -> + {I2, Relocs2} = trans_comment(I, Relocs), + {I2, Relocs2, Data}; + #enter{} -> + {I2, Relocs2} = trans_enter(I, Relocs), + {I2, Relocs2, Data}; + #fconv{} -> + {I2, Relocs2} = trans_fconv(I, Relocs), + {I2, Relocs2, Data}; + #fload{} -> + {I2, Relocs2} = trans_fload(I, Relocs), + {I2, Relocs2, Data}; + #fmove{} -> + {I2, Relocs2} = trans_fmove(I, Relocs), + {I2, Relocs2, Data}; + #fp{} -> + {I2, Relocs2} = trans_fp(I, Relocs), + {I2, Relocs2, Data}; + #fp_unop{} -> + {I2, Relocs2} = trans_fp_unop(I, Relocs), + {I2, Relocs2, Data}; + #fstore{} -> + {I2, Relocs2} = trans_fstore(I, Relocs), + {I2, Relocs2, Data}; + #goto{} -> + {I2, Relocs2} = trans_goto(I, Relocs), + {I2, Relocs2, Data}; + #label{} -> + {I2, Relocs2} = trans_label(I, Relocs), + {I2, Relocs2, Data}; + #load{} -> + {I2, Relocs2} = trans_load(I, Relocs), + {I2, Relocs2, Data}; + #load_address{} -> + {I2, Relocs2} = trans_load_address(I, Relocs), + {I2, Relocs2, Data}; + #load_atom{} -> + {I2, Relocs2} = trans_load_atom(I, Relocs), + {I2, Relocs2, Data}; + #move{} -> + {I2, Relocs2} = trans_move(I, Relocs), + {I2, Relocs2, Data}; + #return{} -> + {I2, Relocs2} = trans_return(I, Relocs), + {I2, Relocs2, Data}; + #store{} -> + {I2, Relocs2} = trans_store(I, Relocs), + {I2, Relocs2, Data}; + #switch{} -> %% Only switch instruction updates Data + {I2, Relocs2, NewData} = trans_switch(I, Relocs, Data), + {I2, Relocs2, NewData}; + Other -> + exit({?MODULE, translate_instr, {"Unknown RTL instruction", Other}}) + end. + +%% +%% alu +%% +trans_alu(I, Relocs) -> + RtlDst = hipe_rtl:alu_dst(I), + TmpDst = mk_temp(), + {Src1, I1} = trans_src(hipe_rtl:alu_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alu_src2(I)), + Op = trans_op(hipe_rtl:alu_op(I)), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_operation(TmpDst, Op, WordTy, Src1, Src2, []), + I4 = store_stack_dst(TmpDst, RtlDst), + {[I4, I3, I2, I1], Relocs}. + +%% +%% alub +%% +trans_alub(I, Relocs) -> + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= not_overflow -> + trans_alub_overflow(I, signed, Relocs); + ltu -> %% ltu means unsigned overflow + trans_alub_overflow(I, unsigned, Relocs); + _ -> + trans_alub_no_overflow(I, Relocs) + end. + +trans_alub_overflow(I, Sign, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:alub_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alub_src2(I)), + RtlDst = hipe_rtl:alub_dst(I), + TmpDst = mk_temp(), + Name = trans_alub_op(I, Sign), + NewRelocs = relocs_store(Name, {call, {llvm, Name, 2}}, Relocs), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ReturnType = hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), + T1 = mk_temp(), + I3 = hipe_llvm:mk_call(T1, false, [], [], ReturnType, "@" ++ Name, + [{WordTy, Src1}, {WordTy, Src2}], []), + %% T1{0}: result of the operation + I4 = hipe_llvm:mk_extractvalue(TmpDst, ReturnType, T1 , "0", []), + I5 = store_stack_dst(TmpDst, RtlDst), + T2 = mk_temp(), + %% T1{1}: Boolean variable indicating overflow + I6 = hipe_llvm:mk_extractvalue(T2, ReturnType, T1, "1", []), + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= ltu -> + True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + MetaData = branch_metadata(hipe_rtl:alub_pred(I)); + not_overflow -> + True_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + MetaData = branch_metadata(1 - hipe_rtl:alub_pred(I)) + end, + I7 = hipe_llvm:mk_br_cond(T2, True_label, False_label, MetaData), + {[I7, I6, I5, I4, I3, I2, I1], NewRelocs}. + +trans_alub_op(I, Sign) -> + Name = + case Sign of + signed -> + case hipe_rtl:alub_op(I) of + add -> "llvm.sadd.with.overflow."; + mul -> "llvm.smul.with.overflow."; + sub -> "llvm.ssub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end; + unsigned -> + case hipe_rtl:alub_op(I) of + add -> "llvm.uadd.with.overflow."; + mul -> "llvm.umul.with.overflow."; + sub -> "llvm.usub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end + end, + Type = + case hipe_rtl_arch:word_size() of + 4 -> "i32"; + 8 -> "i64" + %% Other -> exit({?MODULE, trans_alub_op, {"Unknown type", Other}}) + end, + Name ++ Type. + +trans_alub_no_overflow(I, Relocs) -> + %% alu + T = hipe_rtl:mk_alu(hipe_rtl:alub_dst(I), hipe_rtl:alub_src1(I), + hipe_rtl:alub_op(I), hipe_rtl:alub_src2(I)), + %% A trans_alu instruction cannot change relocations + {I1, _} = trans_alu(T, Relocs), + %% icmp + %% Translate destination as src, to match with the semantics of instruction + {Dst, I2} = trans_src(hipe_rtl:alub_dst(I)), + Cond = trans_rel_op(hipe_rtl:alub_cond(I)), + T3 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I5 = hipe_llvm:mk_icmp(T3, Cond, WordTy, Dst, "0"), + %% br + Metadata = branch_metadata(hipe_rtl:alub_pred(I)), + True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + I6 = hipe_llvm:mk_br_cond(T3, True_label, False_label, Metadata), + {[I6, I5, I2, I1], Relocs}. + +%% +%% branch +%% +trans_branch(I, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:branch_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:branch_src2(I)), + Cond = trans_rel_op(hipe_rtl:branch_cond(I)), + %% icmp + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_icmp(T1, Cond, WordTy, Src1, Src2), + %% br + True_label = mk_jump_label(hipe_rtl:branch_true_label(I)), + False_label = mk_jump_label(hipe_rtl:branch_false_label(I)), + Metadata = branch_metadata(hipe_rtl:branch_pred(I)), + I4 = hipe_llvm:mk_br_cond(T1, True_label, False_label, Metadata), + {[I4, I3, I2, I1], Relocs}. + +branch_metadata(X) when X =:= 0.5 -> []; +branch_metadata(X) when X > 0.5 -> ?BRANCH_META_TAKEN; +branch_metadata(X) when X < 0.5 -> ?BRANCH_META_NOT_TAKEN. + +%% +%% call +%% +trans_call(I, Relocs) -> + RtlCallArgList= hipe_rtl:call_arglist(I), + RtlCallName = hipe_rtl:call_fun(I), + {I0, Relocs1} = expose_closure(RtlCallName, RtlCallArgList, Relocs), + TmpDst = mk_temp(), + {CallArgs, I1} = trans_call_args(RtlCallArgList), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I3, Relocs2} = + trans_call_name(RtlCallName, Relocs1, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I4 = + case hipe_rtl:call_fail(I) of + %% Normal Call + [] -> + hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, Name, FinalArgs, + []); + %% Call With Exception + FailLabelNum -> + TrueLabel = "L" ++ integer_to_list(hipe_rtl:call_normal(I)), + FailLabel = "%FL" ++ integer_to_list(FailLabelNum), + II1 = + hipe_llvm:mk_invoke(T1, "cc 11", [], FunRetTy, Name, FinalArgs, [], + "%" ++ TrueLabel, FailLabel), + II2 = hipe_llvm:mk_label(TrueLabel), + [II2, II1] + end, + I5 = store_fixed_regs(FixedRegs, T1), + I6 = + case hipe_rtl:call_dstlist(I) of + [] -> []; %% No return value + [Destination] -> + II3 = + hipe_llvm:mk_extractvalue(TmpDst, FunRetTy, T1, + integer_to_list(?NR_PINNED_REGS), []), + II4 = store_stack_dst(TmpDst, Destination), + [II4, II3] + end, + I7 = + case hipe_rtl:call_continuation(I) of + [] -> []; %% No continuation + CC -> + {II5, _} = trans_goto(hipe_rtl:mk_goto(CC), Relocs2), + II5 + end, + {[I7, I6, I5, I4, I3, I2, I1, I0], Relocs2}. + +%% In case of call to a register (closure call) with more than ?NR_ARG_REGS +%% arguments we must track the offset this call in the code, in order to +%% to correct the stack descriptor. So, we insert a new Label and add this label +%% to the "table_closures" +%% --------------------------------|-------------------------------------------- +%% Old Code | New Code +%% --------------------------------|-------------------------------------------- +%% | br %ClosureLabel +%% call %reg(Args) | ClosureLabel: +%% | call %reg(Args) +expose_closure(CallName, CallArgs, Relocs) -> + CallArgsNr = length(CallArgs), + case hipe_rtl:is_reg(CallName) andalso CallArgsNr > ?NR_ARG_REGS of + true -> + LabelNum = hipe_gensym:new_label(llvm), + ClosureLabel = hipe_llvm:mk_label(mk_label(LabelNum)), + JumpIns = hipe_llvm:mk_br(mk_jump_label(LabelNum)), + Relocs1 = + relocs_store({CallName, LabelNum}, + {closure_label, LabelNum, CallArgsNr - ?NR_ARG_REGS}, + Relocs), + {[ClosureLabel, JumpIns], Relocs1}; + false -> + {[], Relocs} + end. + +trans_call_name(RtlCallName, Relocs, CallArgs, FinalArgs) -> + case RtlCallName of + PrimOp when is_atom(PrimOp) -> + LlvmName = trans_prim_op(PrimOp), + Relocs1 = relocs_store(LlvmName, {call, {bif, PrimOp, length(CallArgs)}}, + Relocs), + {"@" ++ LlvmName, [], Relocs1}; + {M, F, A} when is_atom(M), is_atom(F), is_integer(A) -> + LlvmName = trans_mfa_name({M,F,A}), + Relocs1 = relocs_store(LlvmName, {call, {M,F,A}}, Relocs), + {"@" ++ LlvmName, [], Relocs1}; + Reg -> + case hipe_rtl:is_reg(Reg) of + true -> + %% In case of a closure call, the register holding the address + %% of the closure must be converted to function type in + %% order to make the call + TT1 = mk_temp(), + {RegName, II1} = trans_src(Reg), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = + hipe_llvm:mk_conversion(TT1, inttoptr, WordTy, RegName, WordTyPtr), + TT2 = mk_temp(), + ArgsTypeList = lists:duplicate(length(FinalArgs), WordTy), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FunType = hipe_llvm:mk_fun(FunRetTy, ArgsTypeList), + FunTypeP = hipe_llvm:mk_pointer(FunType), + II3 = hipe_llvm:mk_conversion(TT2, bitcast, WordTyPtr, TT1, FunTypeP), + {TT2, [II3, II2, II1], Relocs}; + false -> + exit({?MODULE, trans_call, {"Unimplemented call to", RtlCallName}}) + end + end. + +%% +trans_call_args(ArgList) -> + {Args, I} = lists:unzip(trans_args(ArgList)), + %% Reverse arguments that are passed to stack to match with the Erlang + %% calling convention. (Propably not needed in prim calls.) + ReversedArgs = + case erlang:length(Args) > ?NR_ARG_REGS of + false -> + Args; + true -> + {ArgsInRegs, ArgsInStack} = lists:split(?NR_ARG_REGS, Args), + ArgsInRegs ++ lists:reverse(ArgsInStack) + end, + %% Reverse I, because some of the arguments may go out of scope and + %% should be killed(store -5). When two or more arguments are they + %% same, then order matters! + {ReversedArgs, lists:reverse(I)}. + +%% +%% trans_comment +%% +trans_comment(I, Relocs) -> + I1 = hipe_llvm:mk_comment(hipe_rtl:comment_text(I)), + {I1, Relocs}. + +%% +%% enter +%% +trans_enter(I, Relocs) -> + {CallArgs, I0} = trans_call_args(hipe_rtl:enter_arglist(I)), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I1} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I2, NewRelocs} = + trans_call_name(hipe_rtl:enter_fun(I), Relocs, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, true, "cc 11", [], FunRetTy, Name, FinalArgs, []), + I4 = hipe_llvm:mk_ret([{FunRetTy, T1}]), + {[I4, I3, I2, I1, I0], NewRelocs}. + +%% +%% fconv +%% +trans_fconv(I, Relocs) -> + %% XXX: Can a fconv destination be a precoloured reg? + RtlDst = hipe_rtl:fconv_dst(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(hipe_rtl:fconv_src(I)), + FloatTy = hipe_llvm:mk_double(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_conversion(TmpDst, sitofp, WordTy, Src, FloatTy), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. + + +%% TODO: fload, fstore, fmove, and fp are almost the same with load, store, move +%% and alu. Maybe we should join them. + +%% +%% fload +%% +trans_fload(I, Relocs) -> + RtlDst = hipe_rtl:fload_dst(I), + RtlSrc = hipe_rtl:fload_src(I), + _Offset = hipe_rtl:fload_offset(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + {Offset, I2} = trans_float_src(_Offset), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + T2 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, FloatTyPtr), + I5 = hipe_llvm:mk_load(TmpDst, FloatTyPtr, T2, [], [], false), + I6 = store_float_stack(TmpDst, RtlDst), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fmove +%% +trans_fmove(I, Relocs) -> + RtlDst = hipe_rtl:fmove_dst(I), + RtlSrc = hipe_rtl:fmove_src(I), + {Src, I1} = trans_float_src(RtlSrc), + I2 = store_float_stack(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% fp +%% +trans_fp(I, Relocs) -> + %% XXX: Just copied trans_alu...think again.. + RtlDst = hipe_rtl:fp_dst(I), + RtlSrc1 = hipe_rtl:fp_src1(I), + RtlSrc2 = hipe_rtl:fp_src2(I), + %% Destination cannot be a precoloured register + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + TmpDst = mk_temp(), + {Src1, I1} = trans_float_src(RtlSrc1), + {Src2, I2} = trans_float_src(RtlSrc2), + Op = trans_fp_op(hipe_rtl:fp_op(I)), + I3 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, Src1, Src2, []), + I4 = store_float_stack(TmpDst, RtlDst), + %% Synchronization for floating point exceptions + I5 = hipe_llvm:mk_store(FloatTy, TmpDst, FloatTyPtr, "%exception_sync", [], + [], true), + T1 = mk_temp(), + I6 = hipe_llvm:mk_load(T1, FloatTyPtr, "%exception_sync", [], [], true), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fp_unop +%% +trans_fp_unop(I, Relocs) -> + RtlDst = hipe_rtl:fp_unop_dst(I), + RtlSrc = hipe_rtl:fp_unop_src(I), + %% Destination cannot be a precoloured register + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + Op = trans_fp_op(hipe_rtl:fp_unop_op(I)), + FloatTy = hipe_llvm:mk_double(), + I2 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, "0.0", Src, []), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. +%% TODO: Fix fp_unop in a way like the following. You must change trans_dest, +%% in order to call float_to_list in a case of float constant. Maybe the type +%% check is expensive... +%% Dst = hipe_rtl:fp_unop_dst(I), +%% Src = hipe_rtl:fp_unop_src(I), +%% Op = hipe_rtl:fp_unop_op(I), +%% Zero = hipe_rtl:mk_imm(0.0), +%% I1 = hipe_rtl:mk_fp(Dst, Zero, Op, Src), +%% trans_fp(I, Relocs1). + +%% +%% fstore +%% +trans_fstore(I, Relocs) -> + Base = hipe_rtl:fstore_base(I), + case isPrecoloured(Base) of + true -> + trans_fstore_reg(I, Relocs); + false -> + exit({?MODULE, trans_fstore ,{"Not implemented yet", false}}) + end. + +trans_fstore_reg(I, Relocs) -> + {Base, I0} = trans_reg(hipe_rtl:fstore_base(I), dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Base, [], [], false), + {Offset, I2} = trans_src(hipe_rtl:fstore_offset(I)), + T2 = mk_temp(), + I3 = hipe_llvm:mk_operation(T2, add, WordTy, T1, Offset, []), + T3 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T3, inttoptr, WordTy, T2, FloatTyPtr), + {Value, I5} = trans_src(hipe_rtl:fstore_src(I)), + I6 = hipe_llvm:mk_store(FloatTy, Value, FloatTyPtr, T3, [], [], false), + {[I6, I5, I4, I3, I2, I1, I0], Relocs}. + +%% +%% goto +%% +trans_goto(I, Relocs) -> + I1 = hipe_llvm:mk_br(mk_jump_label(hipe_rtl:goto_label(I))), + {I1, Relocs}. + +%% +%% label +%% +trans_label(I, Relocs) -> + Label = mk_label(hipe_rtl:label_name(I)), + I1 = hipe_llvm:mk_label(Label), + {I1, Relocs}. + +%% +%% load +%% +trans_load(I, Relocs) -> + RtlDst = hipe_rtl:load_dst(I), + TmpDst = mk_temp(), + %% XXX: Why translate them independently? ------------------------ + {Src, I1} = trans_src(hipe_rtl:load_src(I)), + {Offset, I2} = trans_src(hipe_rtl:load_offset(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + %%---------------------------------------------------------------- + I4 = case hipe_rtl:load_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_load(TmpDst, WordTyPtr, T2, [], [], false), + [II2, II1]; + Size -> + LoadType = llvm_type_from_size(Size), + LoadTypeP = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypeP), + T3 = mk_temp(), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + II2 = hipe_llvm:mk_load(T3, LoadTypePointer, T2, [], [], false), + Conversion = + case hipe_rtl:load_sign(I) of + signed -> sext; + unsigned -> zext + end, + II3 = + hipe_llvm:mk_conversion(TmpDst, Conversion, LoadType, T3, WordTy), + [II3, II2, II1] + end, + I5 = store_stack_dst(TmpDst, RtlDst), + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% load_address +%% +trans_load_address(I, Relocs) -> + RtlDst = hipe_rtl:load_address_dst(I), + RtlAddr = hipe_rtl:load_address_addr(I), + {Addr, NewRelocs} = + case hipe_rtl:load_address_type(I) of + constant -> + {"%DL" ++ integer_to_list(RtlAddr) ++ "_var", Relocs}; + closure -> + {{_, ClosureName, _}, _, _} = RtlAddr, + FixedClosureName = fix_closure_name(ClosureName), + Relocs1 = relocs_store(FixedClosureName, {closure, RtlAddr}, Relocs), + {"%" ++ FixedClosureName ++ "_var", Relocs1}; + type -> + exit({?MODULE, trans_load_address, + {"Type not implemented in load_address", RtlAddr}}) + end, + I1 = store_stack_dst(Addr, RtlDst), + {[I1], NewRelocs}. + +%% +%% load_atom +%% +trans_load_atom(I, Relocs) -> + RtlDst = hipe_rtl:load_atom_dst(I), + RtlAtom = hipe_rtl:load_atom_atom(I), + AtomName = "atom_" ++ make_llvm_id(atom_to_list(RtlAtom)), + AtomVar = "%" ++ AtomName ++ "_var", + NewRelocs = relocs_store(AtomName, {atom, RtlAtom}, Relocs), + I1 = store_stack_dst(AtomVar, RtlDst), + {[I1], NewRelocs}. + +%% +%% move +%% +trans_move(I, Relocs) -> + RtlDst = hipe_rtl:move_dst(I), + RtlSrc = hipe_rtl:move_src(I), + {Src, I1} = trans_src(RtlSrc), + I2 = store_stack_dst(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% return +%% +trans_return(I, Relocs) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + {VarRet, I1} = + case hipe_rtl:return_varlist(I) of + [] -> + {[], []}; + [A] -> + {Name, II1} = trans_src(A), + {[{WordTy, Name}], II1} + end, + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FixedRet = [{WordTy, X} || X <- LoadedFixedRegs], + Ret = FixedRet ++ VarRet, + {RetTypes, _RetNames} = lists:unzip(Ret), + Type = hipe_llvm:mk_struct(RetTypes), + {RetStruct, I3} = mk_return_struct(Ret, Type), + I4 = hipe_llvm:mk_ret([{Type, RetStruct}]), + {[I4, I3, I2, I1], Relocs}. + +%% @doc Create a structure to hold the return value and the precoloured +%% registers. +mk_return_struct(RetValues, Type) -> + mk_return_struct(RetValues, Type, [], "undef", 0). + +mk_return_struct([], _, Acc, StructName, _) -> + {StructName, Acc}; +mk_return_struct([{ElemType, ElemName}|Rest], Type, Acc, StructName, Index) -> + T1 = mk_temp(), + I1 = hipe_llvm:mk_insertvalue(T1, Type, StructName, ElemType, ElemName, + integer_to_list(Index), []), + mk_return_struct(Rest, Type, [I1 | Acc], T1, Index+1). + +%% +%% store +%% +trans_store(I, Relocs) -> + {Base, I1} = trans_src(hipe_rtl:store_base(I)), + {Offset, I2} = trans_src(hipe_rtl:store_offset(I)), + {Value, I3} = trans_src(hipe_rtl:store_src(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I4 = hipe_llvm:mk_operation(T1, add, WordTy, Base, Offset, []), + I5 = + case hipe_rtl:store_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_store(WordTy, Value, WordTyPtr, T2, [], [], + false), + [II2, II1]; + Size -> + %% XXX: Is always trunc correct ? + LoadType = llvm_type_from_size(Size), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypePointer), + T3 = mk_temp(), + II2 = hipe_llvm:mk_conversion(T3, 'trunc', WordTy, Value, LoadType), + II3 = hipe_llvm:mk_store(LoadType, T3, LoadTypePointer, T2, [], [], false), + [II3, II2, II1] + end, + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% switch +%% +trans_switch(I, Relocs, Data) -> + RtlSrc = hipe_rtl:switch_src(I), + {Src, I1} = trans_src(RtlSrc), + Labels = hipe_rtl:switch_labels(I), + JumpLabels = [mk_jump_label(L) || L <- Labels], + SortOrder = hipe_rtl:switch_sort_order(I), + NrLabels = length(Labels), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + TableTypeP = hipe_llvm:mk_pointer(TableType), + TypedJumpLabels = [{hipe_llvm:mk_label_type(), X} || X <- JumpLabels], + T1 = mk_temp(), + {Src2, []} = trans_dst(RtlSrc), + TableName = "table_" ++ tl(Src2), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_getelementptr(T1, TableTypeP, "@"++TableName, + [{WordTy, "0"}, {WordTy, Src}], false), + T2 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I3 = hipe_llvm:mk_load(T2, BYTE_TYPE_PP, T1, [], [], false), + I4 = hipe_llvm:mk_indirectbr(ByteTyPtr, T2, TypedJumpLabels), + LMap = [{label, L} || L <- Labels], + %% Update data with the info for the jump table + {NewData, JTabLab} = + case hipe_rtl:switch_sort_order(I) of + [] -> + hipe_consttab:insert_block(Data, word, LMap); + SortOrder -> + hipe_consttab:insert_sorted_block(Data, word, LMap, SortOrder) + end, + Relocs2 = relocs_store(TableName, {switch, {TableType, Labels, NrLabels, + SortOrder}, JTabLab}, Relocs), + {[I4, I3, I2, I1], Relocs2, NewData}. + +%% @doc Pass on RTL code in order to fix invoke and closure calls. +fix_code(Code) -> + fix_calls(Code). + +%% @doc Fix invoke calls and closure calls with more than ?NR_ARG_REGS +%% arguments. +fix_calls(Code) -> + fix_calls(Code, [], []). + +fix_calls([], Acc, FailLabels) -> + {lists:reverse(Acc), FailLabels}; +fix_calls([I | Is], Acc, FailLabels) -> + case hipe_rtl:is_call(I) of + true -> + {NewCall, NewFailLabels} = + case hipe_rtl:call_fail(I) of + [] -> + {I, FailLabels}; + FailLabel -> + fix_invoke_call(I, FailLabel, FailLabels) + end, + fix_calls(Is, [NewCall|Acc], NewFailLabels); + false -> + fix_calls(Is, [I|Acc], FailLabels) + end. + +%% @doc When a call has a fail continuation label it must be extended with a +%% normal continuation label to go with the LLVM's invoke instruction. +%% FailLabels is the list of labels of all fail blocks, which are needed to +%% be declared as landing pads. Furtermore, we must add to fail labels a +%% call to hipe_bifs:llvm_fix_pinned_regs/0 in order to avoid reloading old +%% values of pinned registers. This may happen because the result of an +%% invoke instruction is not available at fail-labels, and, thus, we cannot +%% get the correct values of pinned registers. Finally, the stack needs to +%% be re-adjusted when there are stack arguments. +fix_invoke_call(I, FailLabel, FailLabels) -> + NewLabel = hipe_gensym:new_label(llvm), + NewCall1 = hipe_rtl:call_normal_update(I, NewLabel), + SpAdj = find_sp_adj(hipe_rtl:call_arglist(I)), + case lists:keyfind(FailLabel, 1, FailLabels) of + %% Same fail label with same Stack Pointer adjustment + {FailLabel, NewFailLabel, SpAdj} -> + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, FailLabels}; + %% Same fail label but with different Stack Pointer adjustment + {_, _, _} -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]}; + %% New Fail label + false -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]} + end. + +find_sp_adj(ArgList) -> + NrArgs = length(ArgList), + case NrArgs > ?NR_ARG_REGS of + true -> + (NrArgs - ?NR_ARG_REGS) * hipe_rtl_arch:word_size(); + false -> + 0 + end. + +%% @doc Add landingpad instruction in Fail Blocks. +add_landingpads(LLVM_Code, FailLabels) -> + FailLabels2 = [convert_label(T) || T <- FailLabels], + add_landingpads(LLVM_Code, FailLabels2, []). + +add_landingpads([], _, Acc) -> + lists:reverse(Acc); +add_landingpads([I | Is], FailLabels, Acc) -> + case hipe_llvm:is_label(I) of + true -> + Label = hipe_llvm:label_label(I), + Ins = create_fail_blocks(Label, FailLabels), + add_landingpads(Is, FailLabels, [I | Ins] ++ Acc); + false -> + add_landingpads(Is, FailLabels, [I | Acc]) + end. + +convert_label({X,Y,Z}) -> + {"L" ++ integer_to_list(X), "FL" ++ integer_to_list(Y), Z}. + +%% @doc Create a fail block wich. +create_fail_blocks(_, []) -> []; +create_fail_blocks(Label, FailLabels) -> + create_fail_blocks(Label, FailLabels, []). + +create_fail_blocks(Label, FailLabels, Acc) -> + case lists:keytake(Label, 1, FailLabels) of + false -> + Acc; + {value, {Label, FailLabel, SpAdj}, RestFailLabels} -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I1 = hipe_llvm:mk_label(FailLabel), + LP = hipe_llvm:mk_landingpad(), + I2 = + case SpAdj > 0 of + true -> + StackPointer = ?ARCH_REGISTERS:reg_name(?ARCH_REGISTERS:sp()), + hipe_llvm:mk_adj_stack(integer_to_list(SpAdj), StackPointer, + WordTy); + false -> [] + end, + T1 = mk_temp(), + FixedRegs = fixed_registers(), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + I4 = store_fixed_regs(FixedRegs, T1), + I5 = hipe_llvm:mk_br("%" ++ Label), + Ins = lists:flatten([I5, I4, I3, I2, LP,I1]), + create_fail_blocks(Label, RestFailLabels, Ins ++ Acc) + end. + +%%------------------------------------------------------------------------------ +%% Miscellaneous Functions +%%------------------------------------------------------------------------------ + +%% @doc Convert RTL argument list to LLVM argument list. +trans_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + MakeArg = + fun(A) -> + {Name, I1} = trans_src(A), + {{WordTy, Name}, I1} + end, + [MakeArg(A) || A <- ArgList]. + +%% @doc Convert a list of Precoloured registers to LLVM argument list. +fix_reg_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, A} || A <- ArgList]. + +%% @doc Load Precoloured registers. +load_fixed_regs(RegList) -> + Names = [mk_temp_reg(R) || R <- RegList], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun (X, Y) -> + hipe_llvm:mk_load(X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], false) + end, + Ins = lists:zipwith(Fun1, Names, RegList), + {Names, Ins}. + +%% @doc Store Precoloured registers. +store_fixed_regs(RegList, Name) -> + Names = [mk_temp_reg(R) || R <- RegList], + Indexes = lists:seq(0, erlang:length(RegList) - 1), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + Fun1 = + fun(X,Y) -> + hipe_llvm:mk_extractvalue(X, FunRetTy, Name, integer_to_list(Y), []) + end, + I1 = lists:zipwith(Fun1, Names, Indexes), + Fun2 = + fun (X, Y) -> + hipe_llvm:mk_store(WordTy, X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], + false) + end, + I2 = lists:zipwith(Fun2, Names, RegList), + [I2, I1]. + +%%------------------------------------------------------------------------------ +%% Translation of Names +%%------------------------------------------------------------------------------ + +%% @doc Fix F in MFA tuple to acceptable LLVM identifier (case of closure). +-spec fix_mfa_name(mfa()) -> mfa(). +fix_mfa_name({Mod_Name, Closure_Name, Arity}) -> + Fun_Name = list_to_atom(fix_closure_name(Closure_Name)), + {Mod_Name, Fun_Name, Arity}. + +%% @doc Make an acceptable LLVM identifier for a closure name. +fix_closure_name(ClosureName) -> + make_llvm_id(atom_to_list(ClosureName)). + +%% @doc Create an acceptable LLVM identifier. +make_llvm_id(Name) -> + case Name of + "" -> "Empty"; + Other -> lists:flatten([llvm_id(C) || C <- Other]) + end. + +llvm_id(C) when C=:=46; C>47 andalso C<58; C>64 andalso C<91; C=:=95; + C>96 andalso C<123 -> + C; +llvm_id(C) -> + io_lib:format("_~2.16.0B_",[C]). + +%% @doc Create an acceptable LLVM identifier for an MFA. +trans_mfa_name({M,F,A}) -> + N = atom_to_list(M) ++ "." ++ atom_to_list(F) ++ "." ++ integer_to_list(A), + make_llvm_id(N). + +%%------------------------------------------------------------------------------ +%% Creation of Labels and Temporaries +%%------------------------------------------------------------------------------ +mk_label(N) -> + "L" ++ integer_to_list(N). + +mk_jump_label(N) -> + "%L" ++ integer_to_list(N). + +mk_temp() -> + "%t" ++ integer_to_list(hipe_gensym:new_var(llvm)). + +mk_temp_reg(Name) -> + "%" ++ Name ++ integer_to_list(hipe_gensym:new_var(llvm)). + +%%---------------------------------------------------------------------------- +%% Translation of Operands +%%---------------------------------------------------------------------------- + +store_stack_dst(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = hipe_llvm:mk_store(WordTy, TempDst, WordTyPtr, Dst2, [], [], false), + [II2, II1]. + +store_float_stack(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + II2 = hipe_llvm:mk_store(FloatTy, TempDst, FloatTyPtr, Dst2, [], [], false), + [II2, II1]. + +trans_float_src(Src) -> + case hipe_rtl:is_const_label(Src) of + true -> + Name = "@DL" ++ integer_to_list(hipe_rtl:const_label_label(Src)), + T1 = mk_temp(), + %% XXX: Hardcoded offset + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + I1 = hipe_llvm:mk_getelementptr(T1, ByteTyPtr, Name, + [{ByteTy, integer_to_list(?FLOAT_OFFSET)}], true), + T2 = mk_temp(), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + I2 = hipe_llvm:mk_conversion(T2, bitcast, ByteTyPtr, T1, FloatTyPtr), + T3 = mk_temp(), + I3 = hipe_llvm:mk_load(T3, FloatTyPtr, T2, [], [], false), + {T3, [I3, I2, I1]}; + false -> + trans_src(Src) + end. + +trans_src(A) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case hipe_rtl:is_imm(A) of + true -> + Value = integer_to_list(hipe_rtl:imm_value(A)), + {Value, []}; + false -> + case hipe_rtl:is_reg(A) of + true -> + case isPrecoloured(A) of + true -> trans_reg(A, src); + false -> + {Name, []} = trans_reg(A, src), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false), + {T1, [I1]} + end; + false -> + case hipe_rtl:is_var(A) of + true -> + RootName = "%vr" ++ integer_to_list(hipe_rtl:var_index(A)), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, RootName, [], [], false), + I2 = + case hipe_rtl:var_liveness(A) of + live -> + []; + dead -> + NilValue = hipe_tagscheme:mk_nil(), + hipe_llvm:mk_store(WordTy, integer_to_list(NilValue), WordTyPtr, RootName, + [], [], false) + end, + {T1, [I2, I1]}; + false -> + case hipe_rtl:is_fpreg(A) of + true -> + {Name, []} = trans_dst(A), + T1 = mk_temp(), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I1 = hipe_llvm:mk_load(T1, FloatTyPtr, Name, [], [], false), + {T1, [I1]}; + false -> trans_dst(A) + end + end + end + end. + +trans_dst(A) -> + case hipe_rtl:is_reg(A) of + true -> + trans_reg(A, dst); + false -> + Name = case hipe_rtl:is_var(A) of + true -> + "%vr" ++ integer_to_list(hipe_rtl:var_index(A)); + false -> + case hipe_rtl:is_fpreg(A) of + true -> "%fr" ++ integer_to_list(hipe_rtl:fpreg_index(A)); + false -> + case hipe_rtl:is_const_label(A) of + true -> + "%DL" ++ integer_to_list(hipe_rtl:const_label_label(A)) ++ "_var"; + false -> + exit({?MODULE, trans_dst, {"Bad RTL argument",A}}) + end + end + end, + {Name, []} + end. + +%% @doc Translate a register. If it is precoloured it must be mapped to the +%% correct stack slot that holds the precoloured register value. +trans_reg(Arg, Position) -> + Index = hipe_rtl:reg_index(Arg), + case isPrecoloured(Arg) of + true -> + Name = map_precoloured_reg(Index), + case Position of + src -> fix_reg_src(Name); + dst -> fix_reg_dst(Name) + end; + false -> + {hipe_rtl_arch:reg_name(Index), []} + end. + +map_precoloured_reg(Index) -> + case hipe_rtl_arch:reg_name(Index) of + "%r15" -> "%hp_reg_var"; + "%rbp" -> "%p_reg_var"; + "%esi" -> "%hp_reg_var"; + "%ebp" -> "%p_reg_var"; + "%fcalls" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:fcalls())}; + "%hplim" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:heap_limit())}; + _ -> + exit({?MODULE, map_precoloured_reg, {"Register not mapped yet", Index}}) + end. + +%% @doc Load precoloured dst register. +fix_reg_dst(Register) -> + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + pointer_from_reg(Name, WordTy, Offset); + Name -> %% Case of %p and %hp + {Name, []} + end. + +%% @doc Load precoloured src register. +fix_reg_src(Register) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + {T1, I1} = pointer_from_reg(Name, WordTy, Offset), + T2 = mk_temp(), + I2 = hipe_llvm:mk_load(T2, WordTyPtr, T1, [], [] , false), + {T2, [I2, I1]}; + Name -> %% Case of %p and %hp + T1 = mk_temp(), + {T1, hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false)} + end. + +%% @doc Load %fcalls and %hplim. +pointer_from_reg(RegName, Type, Offset) -> + PointerType = hipe_llvm:mk_pointer(Type), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, PointerType, RegName, [], [] ,false), + T2 = mk_temp(), + I2 = hipe_llvm:mk_conversion(T2, inttoptr, Type, T1, PointerType), + T3 = mk_temp(), + %% XXX: Offsets should be a power of 2. + I3 = hipe_llvm:mk_getelementptr(T3, PointerType, T2, + [{Type, integer_to_list(Offset div hipe_rtl_arch:word_size())}], true), + {T3, [I3, I2, I1]}. + +isPrecoloured(X) -> + hipe_rtl_arch:is_precoloured(X). + +%%------------------------------------------------------------------------------ +%% Translation of operators +%%------------------------------------------------------------------------------ + +trans_op(Op) -> + case Op of + add -> add; + sub -> sub; + 'or' -> 'or'; + 'and' -> 'and'; + 'xor' -> 'xor'; + sll -> shl; + srl -> lshr; + sra -> ashr; + mul -> mul; + 'fdiv' -> fdiv; + 'sdiv' -> sdiv; + 'srem' -> srem; + Other -> exit({?MODULE, trans_op, {"Unknown RTL operator", Other}}) + end. + +trans_rel_op(Op) -> + case Op of + eq -> eq; + ne -> ne; + gtu -> ugt; + geu -> uge; + ltu -> ult; + leu -> ule; + gt -> sgt; + ge -> sge; + lt -> slt; + le -> sle + end. + +trans_prim_op(Op) -> + case Op of + '+' -> "bif_add"; + '-' -> "bif_sub"; + '*' -> "bif_mul"; + 'div' -> "bif_div"; + '/' -> "bif_div"; + Other -> atom_to_list(Other) + end. + +trans_fp_op(Op) -> + case Op of + fadd -> fadd; + fsub -> fsub; + fdiv -> fdiv; + fmul -> fmul; + fchs -> fsub; + Other -> exit({?MODULE, trans_fp_op, {"Unknown RTL float operator",Other}}) + end. + +%% Misc. +insn_dst(I) -> + case I of + #alu{} -> + [hipe_rtl:alu_dst(I)]; + #alub{} -> + [hipe_rtl:alub_dst(I)]; + #call{} -> + case hipe_rtl:call_dstlist(I) of + [] -> []; + [Dst] -> [Dst] + end; + #load{} -> + [hipe_rtl:load_dst(I)]; + #load_address{} -> + [hipe_rtl:load_address_dst(I)]; + #load_atom{} -> + [hipe_rtl:load_atom_dst(I)]; + #move{} -> + [hipe_rtl:move_dst(I)]; + #phi{} -> + [hipe_rtl:phi_dst(I)]; + #fconv{} -> + [hipe_rtl:fconv_dst(I)]; + #fload{} -> + [hipe_rtl:fload_dst(I)]; + #fmove{} -> + [hipe_rtl:fmove_dst(I)]; + #fp{} -> + [hipe_rtl:fp_dst(I)]; + #fp_unop{} -> + [hipe_rtl:fp_unop_dst(I)]; + _ -> + [] + end. + +llvm_type_from_size(Size) -> + case Size of + byte -> hipe_llvm:mk_int(8); + int16 -> hipe_llvm:mk_int(16); + int32 -> hipe_llvm:mk_int(32); + word -> hipe_llvm:mk_int(64) + end. + +%% @doc Create definition for the compiled function. The parameters that are +%% passed to the stack must be reversed to match with the CC. Also +%% precoloured registers that are passed as arguments must be stored to +%% the corresonding stack slots. +create_function_definition(Fun, Params, Code, LocalVars) -> + FunctionName = trans_mfa_name(Fun), + FixedRegs = fixed_registers(), + %% Reverse parameters to match with the Erlang calling convention + ReversedParams = + case erlang:length(Params) > ?NR_ARG_REGS of + false -> + Params; + true -> + {ParamsInRegs, ParamsInStack} = lists:split(?NR_ARG_REGS, Params), + ParamsInRegs ++ lists:reverse(ParamsInStack) + end, + Args = header_regs(FixedRegs) ++ header_params(ReversedParams), + EntryLabel = hipe_llvm:mk_label("Entry"), + FloatTy = hipe_llvm:mk_double(), + ExceptionSync = hipe_llvm:mk_alloca("%exception_sync", FloatTy, [], []), + I2 = load_regs(FixedRegs), + I3 = hipe_llvm:mk_br(mk_jump_label(get(first_label))), + StoredParams = store_params(Params), + EntryBlock = + lists:flatten([EntryLabel, ExceptionSync, I2, LocalVars, StoredParams, I3]), + Final_Code = EntryBlock ++ Code, + FunctionOptions = [nounwind, noredzone, list_to_atom("gc \"erlang\"")], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + hipe_llvm:mk_fun_def([], [], "cc 11", [], FunRetTy, FunctionName, Args, + FunctionOptions, [], Final_Code). + +header_params(Params) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%v" ++ integer_to_list(hipe_rtl:var_index(P))} || P <- Params]. + +store_params(Params) -> + Fun1 = + fun(X) -> + Index = hipe_rtl:var_index(X), + {Name, _} = trans_dst(X), + ParamName = "%v" ++ integer_to_list(Index), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_store(WordTy, ParamName, WordTyPtr, Name, [], [], false) + end, + lists:map(Fun1, Params). + +fixed_registers() -> + case get(hipe_target_arch) of + x86 -> + ["hp", "p"]; + amd64 -> + ["hp", "p"]; + Other -> + exit({?MODULE, map_registers, {"Unknown architecture", Other}}) + end. + +header_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%" ++ X ++ "_in"} || X <- Registers]. + +load_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun(X) -> + I1 = hipe_llvm:mk_alloca("%" ++ X ++ "_reg_var", WordTy, [], []), + I2 = hipe_llvm:mk_store(WordTy, "%" ++ X ++ "_in", WordTyPtr, + "%" ++ X ++ "_reg_var", [], [], false), + [I1, I2] + end, + lists:map(Fun1, Registers). + +%%------------------------------------------------------------------------------ +%% Relocation-specific Stuff +%%------------------------------------------------------------------------------ + +relocs_store(Key, Value, Relocs) -> + dict:store(Key, Value, Relocs). + +relocs_to_list(Relocs) -> + dict:to_list(Relocs). + +%% @doc This function is responsible for the actions needed to handle +%% relocations: +%% 1) Updates relocations with constants and switch jump tables. +%% 2) Creates LLVM code to declare relocations as external +%% functions/constants. +%% 3) Creates LLVM code in order to create local variables for the external +%% constants/labels. +handle_relocations(Relocs, Data, Fun) -> + RelocsList = relocs_to_list(Relocs), + %% Seperate Relocations according to their type + {CallList, AtomList, ClosureList, ClosureLabels, SwitchList} = + seperate_relocs(RelocsList), + %% Create code to declare atoms + AtomDecl = [declare_atom(A) || A <- AtomList], + %% Create code to create local name for atoms + AtomLoad = [load_atom(A) || A <- AtomList], + %% Create code to declare closures + ClosureDecl = [declare_closure(C) || C <- ClosureList], + %% Create code to create local name for closures + ClosureLoad = [load_closure(C) || C <- ClosureList], + %% Find function calls + IsExternalCall = fun (X) -> is_external_call(X, Fun) end, + ExternalCallList = lists:filter(IsExternalCall, CallList), + %% Create code to declare external function + FunDecl = fixed_fun_decl() ++ [call_to_decl(C) || C <- ExternalCallList], + %% Extract constant labels from Constant Map (remove duplicates) + ConstLabels = hipe_consttab:labels(Data), + %% Create code to declare constants + ConstDecl = [declare_constant(C) || C <- ConstLabels], + %% Create code to create local name for constants + ConstLoad = [load_constant(C) || C <- ConstLabels], + %% Create code to create jump tables + SwitchDecl = declare_switches(SwitchList, Fun), + %% Create code to create a table with the labels of all closure calls + {ClosureLabelDecl, Relocs1} = + declare_closure_labels(ClosureLabels, Relocs, Fun), + %% Enter constants to relocations + Relocs2 = lists:foldl(fun const_to_dict/2, Relocs1, ConstLabels), + %% Temporary Store inc_stack and llvm_fix_pinned_regs to Dictionary + %% TODO: Remove this + Relocs3 = dict:store("inc_stack_0", {call, {bif, inc_stack_0, 0}}, Relocs2), + Relocs4 = dict:store("hipe_bifs.llvm_fix_pinned_regs.0", + {call, {hipe_bifs, llvm_fix_pinned_regs, 0}}, Relocs3), + BranchMetaData = [ + hipe_llvm:mk_branch_meta(?BRANCH_META_TAKEN, "99", "1") + , hipe_llvm:mk_branch_meta(?BRANCH_META_NOT_TAKEN, "1", "99") + ], + ExternalDeclarations = AtomDecl ++ ClosureDecl ++ ConstDecl ++ FunDecl ++ + ClosureLabelDecl ++ SwitchDecl ++ BranchMetaData, + LocalVariables = AtomLoad ++ ClosureLoad ++ ConstLoad, + {Relocs4, ExternalDeclarations, LocalVariables}. + +%% @doc Seperate relocations according to their type. +seperate_relocs(Relocs) -> + seperate_relocs(Relocs, [], [], [], [], []). + +seperate_relocs([], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + {CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc}; +seperate_relocs([R|Rs], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + case R of + {_, {call, _}} -> + seperate_relocs(Rs, [R | CallAcc], AtomAcc, ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {atom, _}} -> + seperate_relocs(Rs, CallAcc, [R | AtomAcc], ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {closure, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, [R | ClosureAcc], LabelAcc, + JmpTableAcc); + {_, {switch, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, LabelAcc, + [R | JmpTableAcc]); + {_, {closure_label, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, [R | LabelAcc], + JmpTableAcc) + end. + +%% @doc External declaration of an atom. +declare_atom({AtomName, _}) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", WordTy, ""). + +%% @doc Creation of local variable for an atom. +load_atom({AtomName, _}) -> + Dst = "%" ++ AtomName ++ "_var", + Name = "@" ++ AtomName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_conversion(Dst, ptrtoint, WordTyPtr, Name, WordTy). + +%% @doc External declaration of a closure. +declare_closure({ClosureName, _})-> + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl("@" ++ ClosureName, "external constant", ByteTy, ""). + +%% @doc Creation of local variable for a closure. +load_closure({ClosureName, _})-> + Dst = "%" ++ ClosureName ++ "_var", + Name = "@" ++ ClosureName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Declaration of a local variable for a switch jump table. +declare_switches(JumpTableList, Fun) -> + FunName = trans_mfa_name(Fun), + [declare_switch_table(X, FunName) || X <- JumpTableList]. + +declare_switch_table({Name, {switch, {TableType, Labels, _, _}, _}}, FunName) -> + LabelList = [mk_jump_label(L) || L <- Labels], + Fun1 = fun(X) -> "i8* blockaddress(@" ++ FunName ++ ", " ++ X ++ ")" end, + List2 = lists:map(Fun1, LabelList), + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + hipe_llvm:mk_const_decl("@" ++ Name, "constant", TableType, List4). + +%% @doc Declaration of a variable for a table with the labels of all closure +%% calls in the code. +declare_closure_labels([], Relocs, _Fun) -> + {[], Relocs}; +declare_closure_labels(ClosureLabels, Relocs, Fun) -> + FunName = trans_mfa_name(Fun), + {LabelList, ArityList} = + lists:unzip([{mk_jump_label(Label), A} || + {_, {closure_label, Label, A}} <- ClosureLabels]), + Relocs1 = relocs_store("table_closures", {table_closures, ArityList}, Relocs), + List2 = + ["i8* blockaddress(@" ++ FunName ++ ", " ++ L ++ ")" || L <- LabelList], + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + NrLabels = length(LabelList), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + ConstDecl = + hipe_llvm:mk_const_decl("@table_closures", "constant", TableType, List4), + {[ConstDecl], Relocs1}. + +%% @doc A call is treated as non external only in a case of a recursive +%% function. +is_external_call({_, {call, Fun}}, Fun) -> false; +is_external_call(_, _) -> true. + +%% @doc External declaration of a function. +call_to_decl({Name, {call, MFA}}) -> + {M, _F, A} = MFA, + CConv = "cc 11", + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + {Type, Args} = + case M of + llvm -> + {hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), [1, 2]}; + %% +precoloured regs + _ -> + {FunRetTy, lists:seq(1, A + ?NR_PINNED_REGS)} + end, + ArgsTypes = lists:duplicate(length(Args), WordTy), + hipe_llvm:mk_fun_decl([], [], CConv, [], Type, "@" ++ Name, ArgsTypes, []). + +%% @doc These functions are always declared, even if not used. +fixed_fun_decl() -> + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + LandPad = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_int(32), + "@__gcc_personality_v0", [hipe_llvm:mk_int(32), hipe_llvm:mk_int(64), + ByteTyPtr, ByteTyPtr], []), + GCROOTDecl = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", [hipe_llvm:mk_pointer(ByteTyPtr), ByteTyPtr], []), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FixPinnedRegs = hipe_llvm:mk_fun_decl([], [], [], [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + GcMetadata = hipe_llvm:mk_const_decl("@gc_metadata", "external constant", + ByteTy, ""), + [LandPad, GCROOTDecl, FixPinnedRegs, GcMetadata]. + +%% @doc Declare an External Consant. We declare all constants as i8 in order to +%% be able to calcucate pointers of the form DL+6, with the getelementptr +%% instruction. Otherwise we have to convert constants form pointers to +%% values, add the offset and convert them again to pointers. +declare_constant(Label) -> + Name = "@DL" ++ integer_to_list(Label), + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl(Name, "external constant", ByteTy, ""). + +%% @doc Load a constant is achieved by converting a pointer to an integer of +%% the correct width. +load_constant(Label) -> + Dst = "%DL" ++ integer_to_list(Label) ++ "_var", + Name = "@DL" ++ integer_to_list(Label), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Store external constants and calls to dictionary. +const_to_dict(Elem, Dict) -> + Name = "DL" ++ integer_to_list(Elem), + dict:store(Name, {'constant', Elem}, Dict). diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index 61d167d01a..e81212d4dc 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -30,6 +30,7 @@ cerl_prettypr, cerl_to_icode, cerl_typean, + elf_format, erl_bif_types, erl_types, hipe, @@ -108,6 +109,10 @@ hipe_ig, hipe_ig_moves, hipe_jit, + hipe_llvm, + hipe_llvm_liveness, + hipe_llvm_main, + hipe_llvm_merge, hipe_ls_regalloc, hipe_main, hipe_moves, @@ -159,6 +164,7 @@ hipe_rtl_symbolic, hipe_rtl_to_amd64, hipe_rtl_to_arm, + hipe_rtl_to_llvm, hipe_rtl_to_ppc, hipe_rtl_to_sparc, hipe_rtl_to_x86, diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 434d5c3061..d47eced6d8 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -821,7 +821,9 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) -> ?debug_msg("Compiled ~w in ~.2f s\n", [MFA,(T2-T1)/1000])), {MFA, Code}; {rtl, LinearRtl} -> - {MFA, LinearRtl} + {MFA, LinearRtl}; + {llvm_binary, Binary} -> + {MFA, Binary} catch error:Error -> ?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])), @@ -890,21 +892,27 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); end. assemble(CompiledCode, Closures, Exports, Options) -> - case get(hipe_target_arch) of - ultrasparc -> - hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); - powerpc -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - ppc64 -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - arm -> - hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); - x86 -> - hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); - amd64 -> - hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); - Arch -> - ?EXIT({executing_on_an_unsupported_architecture, Arch}) + case proplists:get_bool(to_llvm, Options) of + false -> + case get(hipe_target_arch) of + ultrasparc -> + hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); + powerpc -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + ppc64 -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + arm -> + hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); + x86 -> + hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); + amd64 -> + hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); + Arch -> + ?EXIT({executing_on_an_unsupported_architecture, Arch}) + end; + true -> + %% Merge already compiled code (per MFA) to a single binary. + hipe_llvm_merge:finalize(CompiledCode, Closures, Exports) end. %% -------------------------------------------------------------------- @@ -1330,6 +1338,11 @@ opt_keys() -> timeregalloc, timers, to_rtl, + to_llvm, % Use the LLVM backend for compilation. + llvm_save_temps, % Save the LLVM intermediate files in the current + % directory; useful for debugging. + llvm_llc, % Specify llc optimization-level: o1, o2, o3, undefined. + llvm_opt, % Specify opt optimization-level: o1, o2, o3, undefined. use_indexing, use_inline_atom_search, use_callgraph, @@ -1468,11 +1481,19 @@ opt_expansions() -> [{o1, o1_opts()}, {o2, o2_opts()}, {o3, o3_opts()}, + {to_llvm, llvm_opts(o3)}, + {{to_llvm, o0}, llvm_opts(o0)}, + {{to_llvm, o1}, llvm_opts(o1)}, + {{to_llvm, o2}, llvm_opts(o2)}, + {{to_llvm, o3}, llvm_opts(o3)}, {x87, [x87, inline_fp]}, {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86 x86 -> [x87, inline_fp]; %% has sse2 _ -> [inline_fp] end}]. +llvm_opts(O) -> + [to_llvm, {llvm_opt, O}, {llvm_llc, O}]. + %% This expands "basic" options, which may be tested early and cannot be %% in conflict with options found in the source code. diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index 99028cc3c1..89b79998be 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -49,7 +49,7 @@ %%===================================================================== -type comp_icode_ret() :: {'native',hipe_architecture(),{'unprofiled',_}} - | {'rtl',tuple()}. + | {'rtl',tuple()} | {'llvm_binary',term()}. %%===================================================================== @@ -115,11 +115,18 @@ compile_icode(MFA, LinearIcode0, Options, Servers, DebugState) -> pp(IcodeCfg7, MFA, icode_liveness, pp_icode_liveness, Options, Servers), FinalIcode = hipe_icode_cfg:cfg_to_linear(IcodeCfg7), ?opt_stop_timer("Icode"), - LinearRTL = ?option_time(icode_to_rtl(MFA,FinalIcode,Options, Servers), - "RTL", Options), + {LinearRTL, Roots} = ?option_time(icode_to_rtl(MFA, FinalIcode, Options, Servers), + "RTL", Options), case proplists:get_bool(to_rtl, Options) of false -> - rtl_to_native(MFA, LinearRTL, Options, DebugState); + case proplists:get_bool(to_llvm, Options) of + false -> + rtl_to_native(MFA, LinearRTL, Options, DebugState); + true -> + %% The LLVM backend returns binary code, unlike the rest of the HiPE + %% backends which return native assembly. + rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) + end; true -> put(hipe_debug, DebugState), {rtl, LinearRTL} @@ -385,11 +392,21 @@ icode_to_rtl(MFA, Icode, Options, Servers) -> %% hipe_rtl_cfg:pp(RtlCfg3), pp(RtlCfg3, MFA, rtl_liveness, pp_rtl_liveness, Options, Servers), RtlCfg4 = rtl_lcm(RtlCfg3, Options), - pp(RtlCfg4, MFA, rtl, pp_rtl, Options, Servers), - LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg4), + %% LLVM: A liveness analysis on RTL must be performed in order to find the GC + %% roots and explicitly mark them (in RTL) when they go out of scope (only + %% when the LLVM backend is used). + {RtlCfg5, Roots} = + case proplists:get_bool(to_llvm, Options) of + false -> + {RtlCfg4, []}; + true -> + hipe_llvm_liveness:analyze(RtlCfg4) + end, + pp(RtlCfg5, MFA, rtl, pp_rtl, Options, Servers), + LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg5), LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1), %% hipe_rtl:pp(standard_io, LinearRTL2), - LinearRTL2. + {LinearRTL2, Roots}. translate_to_rtl(Icode, Options) -> %% GC tests should have been added in the conversion to Icode. @@ -540,6 +557,17 @@ rtl_to_native(MFA, LinearRTL, Options, DebugState) -> put(hipe_debug, DebugState), LinearNativeCode. +%% Translate Linear RTL to binary code using LLVM. +rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) -> + ?opt_start_timer("LLVM native code"), + %% BinaryCode is a tuple, as defined in llvm/hipe_llvm_main module, which + %% contains the binary code together with info needed by the loader, e.g. + %% ConstTab, Refs, LabelMap, etc. + BinaryCode = hipe_llvm_main:rtl_to_native(MFA, LinearRTL, Roots, Options), + ?opt_stop_timer("LLVM native code"), + put(hipe_debug, DebugState), + {llvm_binary, BinaryCode}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Debugging stuff ... %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/misc/hipe_gensym.erl b/lib/hipe/misc/hipe_gensym.erl index 84fc8fa7e8..4d2a237188 100644 --- a/lib/hipe/misc/hipe_gensym.erl +++ b/lib/hipe/misc/hipe_gensym.erl @@ -44,7 +44,7 @@ %% Types of allowable entities to set global variables for %%----------------------------------------------------------------------- --type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86'. +-type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86' | 'llvm'. %%----------------------------------------------------------------------- diff --git a/lib/hipe/misc/hipe_pack_constants.erl b/lib/hipe/misc/hipe_pack_constants.erl index ca8a9e6bf7..300f9ae43a 100644 --- a/lib/hipe/misc/hipe_pack_constants.erl +++ b/lib/hipe/misc/hipe_pack_constants.erl @@ -20,30 +20,48 @@ %% -module(hipe_pack_constants). --export([pack_constants/2, slim_refs/1, slim_constmap/1]). +-export([pack_constants/2, slim_refs/1, slim_constmap/1, + find_const/2, mk_data_relocs/2, slim_sorted_exportmap/3]). -include("hipe_consttab.hrl"). -include("../../kernel/src/hipe_ext_format.hrl"). +-include("../main/hipe.hrl"). % Needed for the EXIT macro in find_const/2. %%----------------------------------------------------------------------------- --type raw_data() :: binary() | number() | list() | tuple(). --type tbl_ref() :: {hipe_constlbl(), non_neg_integer()}. +-type const_num() :: non_neg_integer(). +-type raw_data() :: binary() | number() | list() | tuple(). + +-type addr() :: non_neg_integer(). +-type ref_p() :: {DataPos :: hipe_constlbl(), CodeOffset :: addr()}. +-type ref() :: ref_p() | {'sorted', Base :: addr(), [ref_p()]}. + +-type mfa_refs() :: {mfa(), [ref()]}. + +%% XXX: these types may not belong here: FIX! +-type fa() :: {atom(), arity()}. +-type export_map() :: [{addr(), module(), atom(), arity()}]. -record(pcm_entry, {mfa :: mfa(), label :: hipe_constlbl(), - const_num :: non_neg_integer(), - start :: non_neg_integer(), + const_num :: const_num(), + start :: addr(), type :: 0 | 1 | 2, raw_data :: raw_data()}). +-type pcm_entry() :: #pcm_entry{}. + +-type label_map() :: gb_trees:tree({mfa(), hipe_constlbl()}, addr()). + +%% Some of the following types may possibly need to be exported +-type data_relocs() :: [ref()]. +-type packed_const_map() :: [pcm_entry()]. +-type mfa_refs_map() :: [mfa_refs()]. +-type slim_export_map() :: [addr() | module() | atom() | arity() | boolean()]. %%----------------------------------------------------------------------------- -spec pack_constants([{mfa(),[_],hipe_consttab()}], ct_alignment()) -> - {ct_alignment(), - non_neg_integer(), - [#pcm_entry{}], - [{mfa(),[tbl_ref() | {'sorted',non_neg_integer(),[tbl_ref()]}]}]}. + {ct_alignment(), non_neg_integer(), packed_const_map(), mfa_refs_map()}. pack_constants(Data, Align) -> pack_constants(Data, 0, Align, 0, [], []). @@ -194,13 +212,12 @@ compact_dests([], Dest, AccofDest, Acc) -> %% to the slimmed and flattened format ConstMap which is put in object %% files. %% --spec slim_constmap([#pcm_entry{}]) -> [raw_data()]. +-spec slim_constmap(packed_const_map()) -> [raw_data()]. slim_constmap(Map) -> slim_constmap(Map, gb_sets:new(), []). --spec slim_constmap([#pcm_entry{}], gb_sets:set(), [raw_data()]) -> [raw_data()]. -slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, - type=Type, raw_data=Term}|Rest], Inserted, Acc) -> +slim_constmap([#pcm_entry{const_num = ConstNo, start = Offset, + type = Type, raw_data = Term}|Rest], Inserted, Acc) -> case gb_sets:is_member(ConstNo, Inserted) of true -> slim_constmap(Rest, Inserted, Acc); @@ -209,3 +226,60 @@ slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, slim_constmap(Rest, NewInserted, [ConstNo, Offset, Type, Term|Acc]) end; slim_constmap([], _Inserted, Acc) -> Acc. + +%% +%% Lookup a constant in a ConstMap. +%% +-spec find_const({mfa(), hipe_constlbl()}, packed_const_map()) -> const_num(). + +find_const({MFA, Label}, [E = #pcm_entry{mfa = MFA, label = Label}|_]) -> + E#pcm_entry.const_num; +find_const(N, [_|R]) -> + find_const(N, R); +find_const(C, []) -> + ?EXIT({constant_not_found, C}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% +%% Functions to build and handle Refs, ExportMap and LabelMap. +%% Note: Moved here because they are used by all backends in +%% hipe_{arm,sparc,ppc,x86}_assemble.erl +%% XXX: Is this the right place for them? +%% + +-spec mk_data_relocs(mfa_refs_map(), label_map()) -> data_relocs(). + +mk_data_relocs(RefsFromConsts, LabelMap) -> + lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). + +mk_data_relocs([{MFA, Labels} | Rest], LabelMap, Acc) -> + Map = [case Label of + {L,Pos} -> + Offset = find({MFA,L}, LabelMap), + {Pos,Offset}; + {sorted,Base,OrderedLabels} -> + {sorted, Base, [begin + Offset = find({MFA,L}, LabelMap), + {Order, Offset} + end + || {L,Order} <- OrderedLabels]} + end + || Label <- Labels], + %% msg("Map: ~w Map\n", [Map]), + mk_data_relocs(Rest, LabelMap, [Map,Acc]); +mk_data_relocs([], _, Acc) -> Acc. + +find({MFA,L}, LabelMap) -> + gb_trees:get({MFA,L}, LabelMap). + +-spec slim_sorted_exportmap(export_map(), [mfa()], [fa()]) -> slim_export_map(). + +slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> + IsClosure = lists:member({M,F,A}, Closures), + IsExported = is_exported(F, A, Exports), + [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; +slim_sorted_exportmap([], _, _) -> []. + +is_exported(F, A, Exports) -> + lists:member({F,A}, Exports). diff --git a/lib/hipe/ppc/hipe_ppc_assemble.erl b/lib/hipe/ppc/hipe_ppc_assemble.erl index b2fd50517b..3ad91f4051 100644 --- a/lib/hipe/ppc/hipe_ppc_assemble.erl +++ b/lib/hipe/ppc/hipe_ppc_assemble.erl @@ -46,8 +46,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -288,7 +288,7 @@ do_pseudo_li(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -574,37 +574,6 @@ mk_y(Pred, BD) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL,LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -642,14 +611,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label}, [{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N, [_|R]) -> - find_const(N, R); -find_const(C, []) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 4bf4eb6bd7..bc61bec0bd 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -29,7 +29,7 @@ %% <li> {alu, Dst, Src1, Op, Src2} </li> %% <li> {alub, Dst, Src1, Op, Src2, RelOp, TrueLabel, FalseLabel, P} </li> %% <li> {branch, Src1, Src2, RelOp, TrueLabel, FalseLabel, P} </li> -%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation} +%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation, NormalContinuation} %% Type is one of {local, remote, primop, closure} </li> %% <li> {comment, Text} </li> %% <li> {enter, Fun, ArgList, Type} @@ -106,7 +106,7 @@ %% rtl_data_update/2, %% rtl_var_range/1, %% rtl_var_range_update/2, - %% rtl_label_range/1, + rtl_label_range/1, %% rtl_label_range_update/2, rtl_info/1, rtl_info_update/2]). @@ -226,6 +226,7 @@ %% goto_label_update/2, mk_call/6, + mk_call/7, call_fun/1, call_dstlist/1, call_dstlist_update/2, @@ -233,8 +234,10 @@ call_continuation/1, call_fail/1, call_type/1, + call_normal/1, + call_normal_update/2, %% call_continuation_update/2, - %% call_fail_update/2, + call_fail_update/2, is_call/1, mk_enter/3, @@ -290,10 +293,13 @@ %% fconv_src_update/2, %% is_fconv/1, - %% mk_var/1, + mk_var/1, + mk_var/2, mk_new_var/0, is_var/1, var_index/1, + var_liveness/1, + var_liveness_update/2, %% change_vars_to_regs/1, @@ -350,10 +356,15 @@ %% move_dst_update/2, fixnumop_dst_update/2, pp_instr/2, - %% pp_arg/2, + %% Uber hack! + pp_var/2, + pp_reg/2, + pp_arg/2, phi_arglist_update/2, phi_redirect_pred/3]). +-export([subst_uses_llvm/2]). + -export_type([alub_cond/0]). %% @@ -387,7 +398,7 @@ rtl_data(#rtl{data=Data}) -> Data. %% rtl_data_update(Rtl, Data) -> Rtl#rtl{data=Data}. %% rtl_var_range(#rtl{var_range=VarRange}) -> VarRange. %% rtl_var_range_update(Rtl, VarRange) -> Rtl#rtl{var_range=VarRange}. -%% rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. +rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. %% rtl_label_range_update(Rtl, LabelRange) -> Rtl#rtl{label_range=LabelRange}. rtl_info(#rtl{info=Info}) -> Info. rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. @@ -643,6 +654,17 @@ is_goto(_) -> false. %% call %% +%% LLVM: Call with normal continuation +mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, + NormalContinuation, Type) -> + case Type of + remote -> ok; + not_remote -> ok + end, + #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, + continuation=Continuation, failcontinuation=FailContinuation, + normalcontinuation=NormalContinuation}. + mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> case Type of remote -> ok; @@ -651,6 +673,10 @@ mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, continuation=Continuation, failcontinuation=FailContinuation}. + +call_normal(#call{normalcontinuation=NormalContinuation}) -> NormalContinuation. +call_normal_update(C, NewNormalContinuation) -> + C#call{normalcontinuation=NewNormalContinuation}. call_dstlist(#call{dstlist=DstList}) -> DstList. call_dstlist_update(C, NewDstList) -> C#call{dstlist=NewDstList}. call_fun(#call{'fun'=Fun}) -> Fun. @@ -853,11 +879,14 @@ reg_is_gcsafe(#rtl_reg{is_gc_safe=IsGcSafe}) -> IsGcSafe. is_reg(#rtl_reg{}) -> true; is_reg(_) -> false. --record(rtl_var, {index :: non_neg_integer()}). +-record(rtl_var, {index :: non_neg_integer(), liveness=live :: dead | live}). mk_var(Num) when is_integer(Num), Num >= 0 -> #rtl_var{index=Num}. +mk_var(Num, Liveness) when is_integer(Num), Num>=0 -> #rtl_var{index=Num, liveness=Liveness}. mk_new_var() -> mk_var(hipe_gensym:get_next_var(rtl)). var_index(#rtl_var{index=Index}) -> Index. +var_liveness(#rtl_var{liveness=Liveness}) -> Liveness. +var_liveness_update(RtlVar, Liveness) -> RtlVar#rtl_var{liveness=Liveness}. is_var(#rtl_var{}) -> true; is_var(_) -> false. @@ -1077,6 +1106,131 @@ subst_uses(Subst, I) -> switch_src_update(I, subst1(Subst, switch_src(I))) end. +subst_uses_llvm(Subst, I) -> + case I of + #alu{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alu_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alu_src1(I)), + I0 = alu_src1_update(I, NewSrc1), + alu_src2_update(I0, NewSrc2); + #alub{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alub_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alub_src1(I)), + I0 = alub_src1_update(I, NewSrc1), + alub_src2_update(I0, NewSrc2); + #branch{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, branch_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, branch_src1(I)), + I0 = branch_src1_update(I, NewSrc1), + branch_src2_update(I0, NewSrc2); + #call{} -> + case call_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, call_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, call_arglist(I)), + I0 = call_fun_update(I, NewFun), + call_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, call_arglist(I)), + call_arglist_update(I, NewArgList) + end; + #comment{} -> + I; + #enter{} -> + case enter_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, enter_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, enter_arglist(I)), + I0 = enter_fun_update(I, NewFun), + enter_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, enter_arglist(I)), + enter_arglist_update(I, NewArgList) + end; + #fconv{} -> + {NewSrc, _ } = subst1_llvm(Subst, fconv_src(I)), + fconv_src_update(I, NewSrc); + #fixnumop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fixnumop_src(I)), + fixnumop_src_update(I, NewSrc); + #fload{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fload_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, fload_offset(I)), + I0 = fload_src_update(I, NewSrc), + fload_offset_update(I0, NewOffset); + #fmove{} -> + {NewSrc, _ } = subst1_llvm(Subst, fmove_src(I)), + fmove_src_update(I, NewSrc); + #fp{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, fp_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, fp_src1(I)), + I0 = fp_src1_update(I, NewSrc1), + fp_src2_update(I0, NewSrc2); + #fp_unop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fp_unop_src(I)), + fp_unop_src_update(I, NewSrc); + #fstore{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fstore_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, fstore_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, fstore_offset(I)), + I0 = fstore_src_update(I, NewSrc), + I1 = fstore_base_update(I0, NewBase), + fstore_offset_update(I1, NewOffset); + #goto{} -> + I; + #goto_index{} -> + I; + #gctest{} -> + {NewWords, _ } = subst1_llvm(Subst, gctest_words(I)), + gctest_words_update(I, NewWords); + #label{} -> + I; + #load{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, load_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, load_offset(I)), + I0 = load_src_update(I, NewSrc), + load_offset_update(I0, NewOffset); + #load_address{} -> + I; + #load_atom{} -> + I; + #load_word_index{} -> + I; + #move{} -> + {NewSrc, _ } = subst1_llvm(Subst, move_src(I)), + move_src_update(I, NewSrc); + #multimove{} -> + {NewSrcList, _} = subst_list_llvm(Subst, multimove_srclist(I)), + multimove_srclist_update(I, NewSrcList); + #phi{} -> + phi_argvar_subst(I, Subst); + #return{} -> + {NewVarList, _} = subst_list_llvm(Subst, return_varlist(I)), + return_varlist_update(I, NewVarList); + #store{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, store_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, store_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, store_offset(I)), + I0 = store_src_update(I, NewSrc), + I1 = store_base_update(I0, NewBase), + store_offset_update(I1, NewOffset); + #switch{} -> + {NewSrc, _ } = subst1_llvm(Subst, switch_src(I)), + switch_src_update(I, NewSrc) + end. + +subst_list_llvm(S,X) -> subst_list_llvm(S, lists:reverse(X), []). +subst_list_llvm(S, [], Acc) -> {Acc, S}; +subst_list_llvm(S, [X|Xs], Acc) -> + {NewX, RestS} = subst1_llvm(S, X), + subst_list_llvm(RestS, Xs, [NewX|Acc]). + +subst1_llvm(A,B) -> subst1_llvm(A,B,[]). + +subst1_llvm([], X, Acc) -> {X, Acc}; +subst1_llvm([{X,Y}|Rs], X, Acc) -> {Y, Acc++Rs}; +subst1_llvm([R|Xs], X, Acc) -> subst1_llvm(Xs,X,[R|Acc]). + subst_defines(Subst, I)-> case I of #alu{} -> @@ -1614,7 +1768,11 @@ pp_var(Dev, Arg) -> true -> pp_hard_reg(Dev, var_index(Arg)); false -> - io:format(Dev, "v~w", [var_index(Arg)]) + io:format(Dev, "v~w", [var_index(Arg)]), + case var_liveness(Arg) of + dead -> io:format(Dev, "(dead)", []); + _ -> ok + end end. pp_arg(Dev, A) -> diff --git a/lib/hipe/rtl/hipe_rtl.hrl b/lib/hipe/rtl/hipe_rtl.hrl index 974e40f830..fbdf9ac524 100644 --- a/lib/hipe/rtl/hipe_rtl.hrl +++ b/lib/hipe/rtl/hipe_rtl.hrl @@ -28,7 +28,8 @@ -record(alu, {dst, src1, op, src2}). -record(alub, {dst, src1, op, src2, 'cond', true_label, false_label, p}). -record(branch, {src1, src2, 'cond', true_label, false_label, p}). --record(call, {dstlist, 'fun', arglist, type, continuation, failcontinuation}). +-record(call, {dstlist, 'fun', arglist, type, continuation, + failcontinuation, normalcontinuation = []}). -record(comment, {text}). -record(enter, {'fun', arglist, type}). -record(fconv, {dst, src}). diff --git a/lib/hipe/rtl/hipe_rtl_liveness.erl b/lib/hipe/rtl/hipe_rtl_liveness.erl index 3cfada9d6c..0c4b6b2e11 100644 --- a/lib/hipe/rtl/hipe_rtl_liveness.erl +++ b/lib/hipe/rtl/hipe_rtl_liveness.erl @@ -34,7 +34,8 @@ -module(hipe_rtl_liveness). -%% -define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. +%% -define(DEBUG_LIVENESS,true). +-define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. -define(PRETTY_PRINT,false). -include("hipe_rtl.hrl"). diff --git a/lib/hipe/sparc/hipe_sparc_assemble.erl b/lib/hipe/sparc/hipe_sparc_assemble.erl index b534fe20ec..68a4e1b349 100644 --- a/lib/hipe/sparc/hipe_sparc_assemble.erl +++ b/lib/hipe/sparc/hipe_sparc_assemble.erl @@ -45,8 +45,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -222,7 +222,7 @@ do_pseudo_set(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -507,37 +507,6 @@ px({pred,Pred}) -> % XXX: use pt/pn throughout entire backend %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -575,14 +544,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl index 7878c7219d..3f756769c4 100644 --- a/lib/hipe/x86/hipe_x86_assemble.erl +++ b/lib/hipe/x86/hipe_x86_assemble.erl @@ -21,7 +21,6 @@ %%% %%% TODO: %%% - Simplify combine_label_maps and mk_data_relocs. -%%% - Move find_const to hipe_pack_constants? -ifdef(HIPE_AMD64). -define(HIPE_X86_ASSEMBLE, hipe_amd64_assemble). @@ -80,8 +79,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% ?debug_msg("Constants are ~w bytes\n",[ConstSize])), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -442,7 +441,7 @@ translate_imm(#x86_imm{value=Imm}, Context, MayTrunc8) -> case Imm of {Label,constant} -> {MFA,ConstMap} = Context, - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {constant,ConstNo}; {Label,closure} -> {closure,Label}; @@ -712,7 +711,7 @@ resolve_jmp_switch_arg(I, _Context) -> {rm64,hipe_amd64_encode:rm_mem(EA)}. -else. resolve_jmp_switch_arg(I, {MFA,ConstMap}) -> - ConstNo = find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), Disp32 = {?LOAD_ADDRESS,{constant,ConstNo}}, SINDEX = ?HIPE_X86_ENCODE:sindex(2, hipe_x86:temp_reg(hipe_x86:jmp_switch_temp(I))), EA = ?HIPE_X86_ENCODE:ea_disp32_sindex(Disp32, SINDEX), % this creates a SIB implicitly @@ -932,37 +931,6 @@ resolve_x87_binop_args(Src=#x86_fpreg{}, Dst=#x86_fpreg{})-> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({MFA,L},LabelMap) -> - gb_trees:get({MFA,L}, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -1001,14 +969,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index 69900bae65..134115bdfa 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -335,7 +335,8 @@ add_domain(Str, #http_cookie{domain = Domain}) -> Str ++ "; $Domain=" ++ Domain. parse_set_cookies(CookieHeaders, DefaultPathDomain) -> - SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders], + %% empty Set-Cookie header is invalid according to RFC but some sites violate it + SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, Value /= ""], Cookies = [parse_set_cookie(SetCookieHeader, DefaultPathDomain) || SetCookieHeader <- SetCookieHeaders], %% print_cookies("Parsed Cookies", Cookies), diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index b4894d93cd..88e08be789 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1119,15 +1119,8 @@ handle_http_body(Body, #state{headers = Headers, handle_response(State#state{headers = NewHeaders, body = NewBody}) end; - Encoding when is_list(Encoding) -> - ?hcrt("handle_http_body - encoding", [{encoding, Encoding}]), - NewState = answer_request(Request, - httpc_response:error(Request, - unknown_encoding), - State), - {stop, normal, NewState}; - _ -> - ?hcrt("handle_http_body - other", []), + Enc when Enc =:= "identity"; Enc =:= undefined -> + ?hcrt("handle_http_body - identity", []), Length = list_to_integer(Headers#http_response_h.'content-length'), case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of @@ -1149,7 +1142,14 @@ handle_http_body(Body, #state{headers = Headers, body_too_big), State), {stop, normal, NewState} - end + end; + Encoding when is_list(Encoding) -> + ?hcrt("handle_http_body - other", [{encoding, Encoding}]), + NewState = answer_request(Request, + httpc_response:error(Request, + unknown_encoding), + State), + {stop, normal, NewState} end. handle_response(#state{status = new} = State) -> diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index ba7e82a765..b1b799c953 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -91,6 +91,7 @@ only_simulated() -> [ cookie, cookie_profile, + empty_set_cookie, trace, stream_once, no_content_204, @@ -104,6 +105,7 @@ only_simulated() -> remote_socket_close, remote_socket_close_async, transfer_encoding, + transfer_encoding_identity, redirect_loop, redirect_moved_permanently, redirect_multiple_choises, @@ -536,6 +538,19 @@ cookie_profile(Config) when is_list(Config) -> inets:stop(httpc, cookie_test). %%------------------------------------------------------------------------- +empty_set_cookie() -> + [{doc, "Test empty Set-Cookie header."}]. +empty_set_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), + + Request0 = {url(group_name(Config), "/empty_set_cookie.html", Config), []}, + + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, Request0, [], []), + + ok = httpc:set_options([{cookies, disabled}]). + +%%------------------------------------------------------------------------- headers_as_is(doc) -> ["Test the option headers_as_is"]; headers_as_is(Config) when is_list(Config) -> @@ -630,6 +645,12 @@ transfer_encoding(Config) when is_list(Config) -> %%------------------------------------------------------------------------- +transfer_encoding_identity(Config) when is_list(Config) -> + URL = url(group_name(Config), "/identity_transfer_encoding.html", Config), + {ok, {{_,200,_}, [_|_], "IDENTITY"}} = httpc:request(URL). + +%%------------------------------------------------------------------------- + empty_response_header() -> [{doc, "Test the case that the HTTP server does not send any headers. Solves OTP-6830"}]. empty_response_header(Config) when is_list(Config) -> @@ -1615,6 +1636,13 @@ handle_uri(_,"/capital_transfer_encoding.html",_,_,Socket,_) -> send(Socket, http_chunk:encode("obar</BODY></HTML>")), http_chunk:encode_last(); +handle_uri(_,"/identity_transfer_encoding.html",_,_,_,_) -> + "HTTP/1.0 200 OK\r\n" + "Transfer-Encoding:identity\r\n" + "Content-Length:8\r\n" + "\r\n" + "IDENTITY"; + handle_uri(_,"/cookie.html",_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "set-cookie:" ++ "test_cookie=true; path=/;" ++ @@ -1622,6 +1650,12 @@ handle_uri(_,"/cookie.html",_,_,_,_) -> "Content-Length:32\r\n\r\n"++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/empty_set_cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie: \r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + handle_uri(_,"/missing_crlf.html",_,_,_,_) -> "HTTP/1.1 200 ok" ++ "Content-Length:32\r\n" ++ diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 6d4b1cb2db..8dae34431b 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -642,6 +642,11 @@ <item> <p>Symbolic links are not supported on this platform.</p> </item> + <tag><c>eperm</c></tag> + <item> + <p>User does not have privileges to create symbolic links + (<c>SeCreateSymbolicLinkPrivilege</c> on Windows).</p> + </item> </taglist> </desc> </func> diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index 976d5e35cb..e5928c7b63 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -194,6 +194,13 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> CodeSize, CodeBinary, Refs, 0,[] % ColdSize, CRrefs ] = binary_to_term(Bin), + ?debug_msg("***** ErLLVM *****~nVersion: ~s~nCheckSum: ~w~nConstAlign: ~w~n" ++ + "ConstSize: ~w~nConstMap: ~w~nLabelMap: ~w~nExportMap ~w~nRefs ~w~n", + [Version, CheckSum, ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap, + Refs]), + %% Write HiPE binary code to a file in the current directory in order to + %% debug by disassembling. + %% file:write_file("erl.o", CodeBinary, [binary]), %% Check that we are loading up-to-date code. version_check(Version, Mod), case hipe_bifs:check_crc(CheckSum) of @@ -221,6 +228,7 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> {MFAs,Addresses} = exports(ExportMap, CodeAddress), %% Remove references to old versions of the module. ReferencesToPatch = get_refs_from(MFAs, []), + %% io:format("References to patch: ~w~n", [ReferencesToPatch]), ok = remove_refs_from(MFAs), %% Patch all dynamic references in the code. %% Function calls, Atoms, Constants, System calls @@ -246,8 +254,7 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> AddressesOfClosuresToPatch = calculate_addresses(ClosurePatches, CodeAddress, Addresses), export_funs(Addresses), - export_funs(Mod, BeamBinary, Addresses, AddressesOfClosuresToPatch), - ok + export_funs(Mod, BeamBinary, Addresses, AddressesOfClosuresToPatch) end, %% Redirect references to the old module to the new module's BEAM stub. patch_to_emu_step2(OldReferencesToPatch), diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 9ffa9adeab..3bda391b8e 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -230,7 +230,9 @@ unix_cmd(Cmd) -> %% and the commands are read from standard input. We set the %% $1 parameter for easy identification of the resident shell. %% --define(SHELL, "/bin/sh -s unix:cmd 2>&1"). +-define(ROOT, "/"). +-define(ROOT_ANDROID, "/system"). +-define(SHELL, "bin/sh -s unix:cmd 2>&1"). -define(PORT_CREATOR_NAME, os_cmd_port_creator). %% @@ -280,7 +282,12 @@ start_port_srv(Request) -> end. start_port_srv_handle({Ref,Client}) -> - Reply = try open_port({spawn, ?SHELL},[stream]) of + Path = case lists:reverse(erlang:system_info(system_architecture)) of + % androideabi + "ibaediordna" ++ _ -> filename:join([?ROOT_ANDROID, ?SHELL]); + _ -> filename:join([?ROOT, ?SHELL]) + end, + Reply = try open_port({spawn, Path},[stream]) of Port when is_port(Port) -> (catch port_connect(Port, Client)), unlink(Port), diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 6b52493f46..f6d6cd94ab 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -428,7 +428,13 @@ make_del_dir(Config) when is_list(Config) -> % because there are processes having that directory as current. ?line ok = ?FILE_MODULE:make_dir(NewDir), ?line {ok,CurrentDir} = file:get_cwd(), - ?line ok = ?FILE_MODULE:set_cwd(NewDir), + case {os:type(), length(NewDir) >= 260 } of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH)\n", []), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + ?line ok = ?FILE_MODULE:set_cwd(NewDir) + end, try %% Check that we get an error when trying to create... %% a deep directory @@ -485,32 +491,39 @@ cur_dir_0(Config) when is_list(Config) -> atom_to_list(?MODULE) ++"_curdir"), ?line ok = ?FILE_MODULE:make_dir(NewDir), - ?line io:format("cd to ~s",[NewDir]), - ?line ok = ?FILE_MODULE:set_cwd(NewDir), - - %% Create a file in the new current directory, and check that it - %% really is created there - ?line UncommonName = "uncommon.fil", - ?line {ok,Fd} = ?FILE_MODULE:open(UncommonName,read_write), - ?line ok = ?FILE_MODULE:close(Fd), - ?line {ok,NewDirFiles} = ?FILE_MODULE:list_dir("."), - ?line true = lists:member(UncommonName,NewDirFiles), - - %% Delete the directory and return to the old current directory - %% and check that the created file isn't there (too!) - ?line expect({error, einval}, {error, eacces}, - ?FILE_MODULE:del_dir(NewDir)), - ?line ?FILE_MODULE:delete(UncommonName), - ?line {ok,[]} = ?FILE_MODULE:list_dir("."), - ?line ok = ?FILE_MODULE:set_cwd(Dir1), - ?line io:format("cd back to ~s",[Dir1]), - ?line ok = ?FILE_MODULE:del_dir(NewDir), - ?line {error, enoent} = ?FILE_MODULE:set_cwd(NewDir), - ?line ok = ?FILE_MODULE:set_cwd(Dir1), - ?line io:format("cd back to ~s",[Dir1]), - ?line {ok,OldDirFiles} = ?FILE_MODULE:list_dir("."), - ?line false = lists:member(UncommonName,OldDirFiles), - + case {os:type(), length(NewDir) >= 260} of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH):\n"), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + io:format("cd to ~s",[NewDir]), + ok = ?FILE_MODULE:set_cwd(NewDir), + + %% Create a file in the new current directory, and check that it + %% really is created there + UncommonName = "uncommon.fil", + {ok,Fd} = ?FILE_MODULE:open(UncommonName,read_write), + ok = ?FILE_MODULE:close(Fd), + {ok,NewDirFiles} = ?FILE_MODULE:list_dir("."), + true = lists:member(UncommonName,NewDirFiles), + + %% Delete the directory and return to the old current directory + %% and check that the created file isn't there (too!) + expect({error, einval}, {error, eacces}, + ?FILE_MODULE:del_dir(NewDir)), + ?FILE_MODULE:delete(UncommonName), + {ok,[]} = ?FILE_MODULE:list_dir("."), + ok = ?FILE_MODULE:set_cwd(Dir1), + io:format("cd back to ~s",[Dir1]), + + ok = ?FILE_MODULE:del_dir(NewDir), + {error, enoent} = ?FILE_MODULE:set_cwd(NewDir), + ok = ?FILE_MODULE:set_cwd(Dir1), + io:format("cd back to ~s",[Dir1]), + {ok,OldDirFiles} = ?FILE_MODULE:list_dir("."), + false = lists:member(UncommonName,OldDirFiles) + end, + %% Try doing some bad things ?line {error, badarg} = ?FILE_MODULE:set_cwd({foo,bar}), ?line {error, enoent} = ?FILE_MODULE:set_cwd(""), @@ -1982,7 +1995,6 @@ names(Config) when is_list(Config) -> ?line Name1 = filename:join(RootDir, FileName), ?line Name2 = [RootDir,"/","foo1",".","fil"], ?line Name3 = [RootDir,"/",foo,$1,[[[],[],'.']],"f",il], - ?line Name4 = list_to_atom(Name1), ?line {ok,Fd0} = ?FILE_MODULE:open(Name1,write), ?line ok = ?FILE_MODULE:close(Fd0), @@ -1995,23 +2007,33 @@ names(Config) when is_list(Config) -> ?line ok = ?FILE_MODULE:close(Fd2), ?line {ok,Fd3} = ?FILE_MODULE:open(Name3,read), ?line ok = ?FILE_MODULE:close(Fd3), - ?line {ok,Fd4} = ?FILE_MODULE:open(Name4,read), - ?line ok = ?FILE_MODULE:close(Fd4), + case length(Name1) > 255 of + true -> + io:format("Path too long for an atom:\n\n~p\n", [Name1]); + false -> + Name4 = list_to_atom(Name1), + {ok,Fd4} = ?FILE_MODULE:open(Name4,read), + ok = ?FILE_MODULE:close(Fd4) + end, %% Try some path names ?line Path1 = RootDir, ?line Path2 = [RootDir], ?line Path3 = ['',[],[RootDir,[[]]]], - ?line Path4 = list_to_atom(Path1), ?line {ok,Fd11,_} = ?FILE_MODULE:path_open([Path1],FileName,read), ?line ok = ?FILE_MODULE:close(Fd11), ?line {ok,Fd12,_} = ?FILE_MODULE:path_open([Path2],FileName,read), ?line ok = ?FILE_MODULE:close(Fd12), ?line {ok,Fd13,_} = ?FILE_MODULE:path_open([Path3],FileName,read), ?line ok = ?FILE_MODULE:close(Fd13), - ?line {ok,Fd14,_} = ?FILE_MODULE:path_open([Path4],FileName,read), - ?line ok = ?FILE_MODULE:close(Fd14), - + case length(Path1) > 255 of + true-> + io:format("Path too long for an atom:\n\n~p\n", [Path1]); + false -> + Path4 = list_to_atom(Path1), + {ok,Fd14,_} = ?FILE_MODULE:path_open([Path4],FileName,read), + ok = ?FILE_MODULE:close(Fd14) + end, ?line [] = flush(), ?line test_server:timetrap_cancel(Dog), ok. @@ -2673,6 +2695,9 @@ symlinks(Config) when is_list(Config) -> case ?FILE_MODULE:make_symlink(Name, Alias) of {error, enotsup} -> {skipped, "Links not supported on this platform"}; + {error, eperm} -> + {win32,_} = os:type(), + {skipped, "Windows user not privileged to create symlinks"}; ok -> ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Name), ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Alias), @@ -3599,7 +3624,11 @@ otp_10852(Config) when is_list(Config) -> ok = rpc_call(Node, list_dir_all, [B]), ok = rpc_call(Node, read_file, [B]), ok = rpc_call(Node, make_link, [B,B]), - ok = rpc_call(Node, make_symlink, [B,B]), + case rpc_call(Node, make_symlink, [B,B]) of + ok -> ok; + {error, E} when (E =:= enotsup) or (E =:= eperm) -> + {win32,_} = os:type() + end, ok = rpc_call(Node, delete, [B]), ok = rpc_call(Node, make_dir, [B]), ok = rpc_call(Node, del_dir, [B]), diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 97d66eab81..05bd5b3a3d 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -266,7 +266,13 @@ make_del_dir(Config, Handle, Suffix) -> % because there are processes having that directory as current. ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), ?line {ok, CurrentDir} = ?PRIM_FILE_call(get_cwd, Handle, []), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + case {os:type(), length(NewDir) >= 260 } of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH)\n", []), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]) + end, try %% Check that we get an error when trying to create... %% a deep directory @@ -335,31 +341,37 @@ cur_dir_0(Config, Handle) -> ?line RootDir = ?config(priv_dir,Config), ?line NewDir = filename:join(RootDir, DirName), ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), - ?line io:format("cd to ~s",[NewDir]), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), - - %% Create a file in the new current directory, and check that it - %% really is created there - ?line UncommonName = "uncommon.fil", - ?line {ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]), - ?line ok = ?PRIM_FILE:close(Fd), - ?line {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), - ?line true = lists:member(UncommonName,NewDirFiles), - - %% Delete the directory and return to the old current directory - %% and check that the created file isn't there (too!) - ?line expect({error, einval}, {error, eacces}, {error, eexist}, + case {os:type(), length(NewDir) >= 260} of + {{win32,_}, true} -> + io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH):\n"), + io:format("\nNewDir = ~p\n", [NewDir]); + _ -> + io:format("cd to ~s",[NewDir]), + ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + + %% Create a file in the new current directory, and check that it + %% really is created there + UncommonName = "uncommon.fil", + {ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]), + ok = ?PRIM_FILE:close(Fd), + {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + true = lists:member(UncommonName,NewDirFiles), + + %% Delete the directory and return to the old current directory + %% and check that the created file isn't there (too!) + expect({error, einval}, {error, eacces}, {error, eexist}, ?PRIM_FILE_call(del_dir, Handle, [NewDir])), - ?line ?PRIM_FILE_call(delete, Handle, [UncommonName]), - ?line {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), - ?line io:format("cd back to ~s",[Dir1]), - ?line ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), - ?line {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), - ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), - ?line io:format("cd back to ~s",[Dir1]), - ?line {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), - ?line false = lists:member(UncommonName,OldDirFiles), + ?PRIM_FILE_call(delete, Handle, [UncommonName]), + {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + io:format("cd back to ~s",[Dir1]), + ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), + {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + io:format("cd back to ~s",[Dir1]), + {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + false = lists:member(UncommonName,OldDirFiles) + end, %% Try doing some bad things ?line {error, badarg} = @@ -1981,6 +1993,9 @@ symlinks(Config, Handle, Suffix) -> case ?PRIM_FILE_call(make_symlink, Handle, [Name, Alias]) of {error, enotsup} -> {skipped, "Links not supported on this platform"}; + {error, eperm} -> + {win32,_} = os:type(), + {skipped, "Windows user not privileged to create links"}; ok -> ?line {ok, Info1} = ?PRIM_FILE_call(read_file_info, Handle, [Name]), diff --git a/lib/os_mon/c_src/memsup.c b/lib/os_mon/c_src/memsup.c index b5114d10ed..409db84aa7 100644 --- a/lib/os_mon/c_src/memsup.c +++ b/lib/os_mon/c_src/memsup.c @@ -324,7 +324,7 @@ get_mem_procfs(memory_ext *me){ /* arch specific functions */ -#if defined(__linux__) /* ifdef SYSINFO */ +#if defined(__linux__) && !defined(__ANDROID__)/* ifdef SYSINFO */ /* sysinfo does not include cached memory which is a problem. */ static int get_extended_mem_sysinfo(memory_ext *me) { @@ -395,8 +395,12 @@ get_extended_mem_sgi(memory_ext *me) { static void get_extended_mem(memory_ext *me) { +/* android */ +#if defined(__ANDROID__) + if (get_mem_procfs(me)) return; + /* linux */ -#if defined(__linux__) +#elif defined(__linux__) if (get_mem_procfs(me)) return; if (get_extended_mem_sysinfo(me)) return; diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 6088e1a2dd..cf8fb3114a 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -55,8 +55,7 @@ -define(exp_size, (?seg_size * ?expand_load)). -define(con_size, (?seg_size * ?contract_load)). --type segs(K, V) :: tuple() - | {K, V}. % dummy +-type segs(_Key, _Value) :: tuple(). %% Define a hashtable. The default values are the standard ones. -record(dict, diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d212a55b47..9b506b0a44 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -33,23 +33,33 @@ -export_type([source_encoding/0]). --type macros() :: [{atom(), term()}]. +-type macros() :: [atom() | {atom(), term()}]. -type epp_handle() :: pid(). -type source_encoding() :: latin1 | utf8. +-type ifdef() :: 'ifdef' | 'ifndef' | 'else'. + +-type name() :: {'atom', atom()}. +-type argspec() :: 'none' %No arguments + | non_neg_integer(). %Number of arguments +-type tokens() :: [erl_scan:token()]. +-type used() :: {name(), argspec()}. + -define(DEFAULT_ENCODING, utf8). %% Epp state record. --record(epp, {file, %Current file +-record(epp, {file :: file:io_device(), %Current file location=1, %Current location - delta, %Offset from Location (-file) - name="", %Current file name - name2="", %-"-, modified by -file - istk=[], %Ifdef stack - sstk=[], %State stack - path=[], %Include-path - macs = dict:new() :: dict:dict(),%Macros (don't care locations) - uses = dict:new() :: dict:dict(),%Macro use structure + delta=0 :: non_neg_integer(), %Offset from Location (-file) + name="" :: file:name(), %Current file name + name2="" :: file:name(), %-"-, modified by -file + istk=[] :: [ifdef()], %Ifdef stack + sstk=[] :: [#epp{}], %State stack + path=[] :: [file:name()], %Include-path + macs = dict:new() %Macros (don't care locations) + :: dict:dict(name(), {argspec(), tokens()}), + uses = dict:new() %Macro use structure + :: dict:dict(name(), [{argspec(), [used()]}]), default_encoding = ?DEFAULT_ENCODING :: source_encoding(), pre_opened = false :: boolean() }). diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 4c0261a1ad..c4c94fbee4 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -80,13 +80,17 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity +-record(typeinfo, {attr, line}). + %% Usage of records, functions, and imports. The variable table, which %% is passed on as an argument, holds the usage of variables. -record(usage, { calls = dict:new(), %Who calls who imported = [], %Actually imported functions - used_records=sets:new() :: sets:set(),%Used record definitions - used_types = dict:new() :: dict:dict()%Used type definitions + used_records = sets:new() %Used record definitions + :: sets:set(atom()), + used_types = dict:new() %Used type definitions + :: dict:dict(ta(), line()) }). %% Define the lint state record. @@ -95,13 +99,17 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -record(lint, {state=start :: 'start' | 'attribute' | 'function', module=[], %Module behaviour=[], %Behaviour - exports=gb_sets:empty() :: gb_sets:set(),%Exports - imports=[], %Imports + exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports + imports=[] :: [fa()], %Imports, an orddict() compile=[], %Compile flags - records=dict:new() :: dict:dict(), %Record definitions - locals=gb_sets:empty() :: gb_sets:set(),%All defined functions (prescanned) - no_auto=gb_sets:empty() :: gb_sets:set() | 'all',%Functions explicitly not autoimported - defined=gb_sets:empty() :: gb_sets:set(),%Defined fuctions + records=dict:new() %Record definitions + :: dict:dict(atom(), {line(),Fields :: term()}), + locals=gb_sets:empty() %All defined functions (prescanned) + :: gb_sets:set(fa()), + no_auto=gb_sets:empty() %Functions explicitly not autoimported + :: gb_sets:set(fa()) | 'all', + defined=gb_sets:empty() %Defined fuctions + :: gb_sets:set(fa()), on_load=[] :: [fa()], %On-load function on_load_line=0 :: line(), %Line for on_load clashes=[], %Exported functions named as BIFs @@ -116,12 +124,16 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %outside any fun or lc xqlc= false :: boolean(), %true if qlc.hrl included new = false :: boolean(), %Has user-defined 'new/N' - called= [] :: [{fa(),line()}], %Called functions + called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, - specs = dict:new() :: dict:dict(), %Type specifications - callbacks = dict:new() :: dict:dict(), %Callback types - types = dict:new() :: dict:dict(), %Type definitions - exp_types=gb_sets:empty():: gb_sets:set()%Exported types + specs = dict:new() %Type specifications + :: dict:dict(mfa(), line()), + callbacks = dict:new() %Callback types + :: dict:dict(mfa(), line()), + types = dict:new() %Type definitions + :: dict:dict(ta(), #typeinfo{}), + exp_types=gb_sets:empty() %Exported types + :: gb_sets:set(ta()) }). -type lint_state() :: #lint{}. @@ -319,10 +331,14 @@ format_error({undefined_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]); format_error({unused_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]); -format_error({new_builtin_type, {TypeName, Arity}}) -> - io_lib:format("type ~w~s is a new builtin type; " +%% format_error({new_builtin_type, {TypeName, Arity}}) -> +%% io_lib:format("type ~w~s is a new builtin type; " +%% "its (re)definition is allowed only until the next release", +%% [TypeName, gen_type_paren(Arity)]); +format_error({new_var_arity_type, TypeName}) -> + io_lib:format("type ~w is a new builtin type; " "its (re)definition is allowed only until the next release", - [TypeName, gen_type_paren(Arity)]); + [TypeName]); format_error({builtin_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is a builtin type; it cannot be redefined", [TypeName, gen_type_paren(Arity)]); @@ -1170,7 +1186,7 @@ export_type(Line, ETs, #lint{usage = Usage, exp_types = ETs0} = St0) -> add_error(Line, {bad_export_type, ETs}, St0) end. --spec exports(lint_state()) -> gb_sets:set(). +-spec exports(lint_state()) -> gb_sets:set(fa()). exports(#lint{compile = Opts, defined = Defs, exports = Es}) -> case lists:member(export_all, Opts) of @@ -2574,8 +2590,6 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. --record(typeinfo, {attr, line}). - type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> %% The record field names and such are checked in the record format. %% We only need to check the types. @@ -2596,23 +2610,30 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> true -> case is_obsolete_builtin_type(TypePair) of true -> StoreType(St0); - false -> - case is_newly_introduced_builtin_type(TypePair) of - %% allow some types just for bootstrapping - true -> - Warn = {new_builtin_type, TypePair}, - St1 = add_warning(Line, Warn, St0), - StoreType(St1); - false -> - add_error(Line, {builtin_type, TypePair}, St0) - end + false -> add_error(Line, {builtin_type, TypePair}, St0) +%% case is_newly_introduced_builtin_type(TypePair) of +%% %% allow some types just for bootstrapping +%% true -> +%% Warn = {new_builtin_type, TypePair}, +%% St1 = add_warning(Line, Warn, St0), +%% StoreType(St1); +%% false -> +%% add_error(Line, {builtin_type, TypePair}, St0) +%% end end; false -> case - dict:is_key(TypePair, TypeDefs) - orelse is_var_arity_type(TypeName) + dict:is_key(TypePair, TypeDefs) orelse + is_var_arity_type(TypeName) of - true -> add_error(Line, {redefine_type, TypePair}, St0); + true -> + case is_newly_introduced_var_arity_type(TypeName) of + true -> + Warn = {new_var_arity_type, TypeName}, + add_warning(Line, Warn, St0); + false -> + add_error(Line, {redefine_type, TypePair}, St0) + end; false -> St1 = case Attr =:= opaque andalso @@ -2847,8 +2868,10 @@ is_default_type({timeout, 0}) -> true; is_default_type({var, 1}) -> true; is_default_type(_) -> false. -%% OTP 17.0 -is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. +is_newly_introduced_var_arity_type(map) -> true; +is_newly_introduced_var_arity_type(_) -> false. + +%% is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. is_obsolete_builtin_type(TypePair) -> obsolete_builtin_type(TypePair) =/= no. diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl index be4b600f25..167a676281 100644 --- a/lib/stdlib/src/sets.erl +++ b/lib/stdlib/src/sets.erl @@ -55,9 +55,8 @@ %%------------------------------------------------------------------------------ --type seg() :: tuple(). --type segs(E) :: tuple() - | E. % dummy +-type seg() :: tuple(). +-type segs(_Element) :: tuple(). %% Define a hash set. The default values are the standard ones. -record(set, diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 673a3cf159..f822986981 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -92,7 +92,7 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps,maps_type]. + maps, maps_type]. groups() -> [{unused_vars_warn, [], @@ -3439,11 +3439,10 @@ maps_type(Config) when is_list(Config) -> t(M) -> M. ">>, [], - {errors,[{3,erl_lint,{redefine_type,{map,0}}}],[]}}], + {warnings,[{3,erl_lint,{new_var_arity_type,map}}]}}], [] = run(Config, Ts), ok. - run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/xcomp/erl-xcomp-arm-android.conf b/xcomp/erl-xcomp-arm-android.conf new file mode 100644 index 0000000000..4fd1f270d1 --- /dev/null +++ b/xcomp/erl-xcomp-arm-android.conf @@ -0,0 +1,264 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009-2010. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +## File: erl-xcomp.conf.template +## Author: +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host=arm-linux-androideabi + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="--disable-hipe --without-termcap" + + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## +## +NDK_SYSROOT=$NDK_ROOT/platforms/$NDK_PLAT/arch-arm + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC="arm-linux-androideabi-gcc --sysroot=$NDK_SYSROOT" + +# * `CFLAGS' - C compiler flags. +CFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +CPP="arm-linux-androideabi-cpp --sysroot=$NDK_SYSROOT" + +# * `CPPFLAGS' - C pre-processor flags. +CPPFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `CXX' - C++ compiler. +CXX="arm-linux-androideabi-c++ --sysroot=$NDK_SYSROOT" + +# * `CXXFLAGS' - C++ compiler flags. +CXXFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `LD' - Linker. +#LD= + +# * `LDFLAGS' - Linker flags. +LDFLAGS="-static -march=armv7-a -msoft-float -mthumb" + +# * `LIBS' - Libraries. +#LIBS= + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +#DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +#DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +#DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +#RANLIB= + +# * `AR' - `ar' archiving tool. +#AR= + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +erl_xcomp_sysroot="$NDK_SYSROOT" + + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +#erl_xcomp_isysroot= + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +#erl_xcomp_poll= + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= + +## ----------------------------------------------------------------------------- |