[Git][ghc/ghc][master] JS: Improve compatibility with recent emsdk
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Aug 7 10:27:35 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
aa07402e by Luite Stegeman at 2023-08-05T23:15:55+09:00
JS: Improve compatibility with recent emsdk
The JavaScript code in libraries/base/jsbits/base.js had some
hardcoded offsets for fields in structs, because we expected
the layout of the data structures to remain unchanged. Emsdk
3.1.42 changed the layout of the stat struct, breaking this
assumption, and causing code in .hsc files accessing the
stat struct to fail.
This patch improves compatibility with recent emsdk by
removing the assumption that data layouts stay unchanged:
1. offsets of fields in structs used by JavaScript code are
now computed by the configure script, so both the .js and
.hsc files will automatically use the new layout if anything
changes.
2. the distrib/configure script checks that the emsdk version
on a user's system is the same version that a bindist was
booted with, to avoid data layout inconsistencies
See #23641
- - - - -
7 changed files:
- configure.ac
- distrib/configure.ac.in
- libraries/base/System/Posix/Internals.hs
- libraries/base/aclocal.m4
- libraries/base/configure.ac
- libraries/base/jsbits/base.js
- + m4/emsdk_version.m4
Changes:
=====================================
configure.ac
=====================================
@@ -461,6 +461,10 @@ FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1])
FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
+dnl ** Do we have a compatible emsdk version?
+dnl --------------------------------------------------------------
+EMSDK_VERSION("3.1.20", "", "")
+
dnl ** Which ld to use
dnl --------------------------------------------------------------
AC_ARG_VAR(LD,[Use as the path to ld. See also --disable-ld-override.])
@@ -531,6 +535,9 @@ sUPPORTED_LLVM_VERSION_MAX=$(echo \($LlvmMaxVersion\) | sed 's/\./,/')
AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MIN], ${sUPPORTED_LLVM_VERSION_MIN}, [The minimum supported LLVM version number])
AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MAX], ${sUPPORTED_LLVM_VERSION_MAX}, [The maximum supported LLVM version number])
+ConfiguredEmsdkVersion="${EmsdkVersion}"
+AC_SUBST([ConfiguredEmsdkVersion])
+
dnl ** Which LLVM llc to use?
dnl --------------------------------------------------------------
AC_ARG_VAR(LLC,[Use as the path to LLVM's llc [default=autodetect]])
=====================================
distrib/configure.ac.in
=====================================
@@ -195,6 +195,10 @@ dnl Identify C++ standard library flavour and location
FP_FIND_CXX_STD_LIB
AC_CONFIG_FILES([mk/system-cxx-std-lib-1.0.conf])
+# Check that we have the same emsdk version as the one we were built with.
+ConfiguredEmsdkVersion=@ConfiguredEmsdkVersion@
+EMSDK_VERSION("", "", ${ConfiguredEmsdkVersion})
+
dnl ** Set up the variables for the platform in the settings file.
dnl May need to use gcc to find platform details.
dnl --------------------------------------------------------------
=====================================
libraries/base/System/Posix/Internals.hs
=====================================
@@ -561,7 +561,7 @@ foreign import javascript unsafe "h$base_tcgetattr"
c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
foreign import javascript unsafe "h$base_tcsetattr"
c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
-foreign import javascript unsafe "h$base_utime" -- should this be async?
+foreign import javascript interruptible "h$base_utime"
c_utime :: CString -> Ptr CUtimbuf -> IO CInt
foreign import javascript interruptible "h$base_waitpid"
c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
@@ -594,7 +594,7 @@ s_isdir cm = c_s_isdir cm /= 0
s_isfifo :: CMode -> Bool
s_isfifo cm = c_s_isfifo cm /= 0
-foreign import javascript unsafe "(() => { return h$base_sizeof_stat; })" sizeof_stat :: Int
+foreign import javascript unsafe "h$base_sizeof_stat" sizeof_stat :: Int
foreign import javascript unsafe "h$base_st_mtime" st_mtime :: Ptr CStat -> IO CTime
foreign import javascript unsafe "h$base_st_size" st_size :: Ptr CStat -> IO Int64
foreign import javascript unsafe "h$base_st_mode" st_mode :: Ptr CStat -> IO CMode
=====================================
libraries/base/aclocal.m4
=====================================
@@ -14,6 +14,32 @@ AC_DEFUN([FP_COMPUTE_INT],
])# FP_COMPUTE_INT
+# FP_COMPUTE_OFFSET(VARIABLE, TYPE, MEMBER, INCLUDES)
+# ---------------------------------------------------
+# Assign VARIABLE the offset of MEMBER in struct TYPE using INCLUDES
+# for compilation. If compilation fails, VARIABLE is set to -1. Works for
+# cross-compilation, too.
+AC_DEFUN([FP_COMPUTE_OFFSET],
+[AC_MSG_CHECKING([offset of [$2].[$3]])
+FP_COMPUTE_INT([$1], [(offsetof(struct [$2], [$3]))], [$4
+#include <stddef.h>], AC_MSG_ERROR([could not determine offset of $2.$3]))
+AC_MSG_RESULT($[$1])
+AC_DEFINE_UNQUOTED([$1], $[$1], [Offset of $2.$3])
+]) # FP_COMPUTE_OFFSET
+
+# FP_COMPUTE_SIZE(VARIABLE, TYPE, MEMBER, INCLUDES)
+# ---------------------------------------------------
+# Assign VARIABLE the offset of MEMBER in struct TYPE using INCLUDES
+# for compilation. If compilation fails, VARIABLE is set to -1. Works for
+# cross-compilation, too.
+AC_DEFUN([FP_COMPUTE_SIZE],
+[AC_MSG_CHECKING([size of [$2].[$3]])
+FP_COMPUTE_INT([$1], [(sizeof(((struct [$2] *)0)->[$3]))], [$4
+#include <stddef.h>], AC_MSG_ERROR([could not determine size of $2.$3]))
+AC_MSG_RESULT($[$1])
+AC_DEFINE_UNQUOTED([$1], $[$1], [Size of $2.$3])
+]) # FP_COMPUTE_SIZE
+
# FP_CHECK_CONST(EXPRESSION, [INCLUDES = DEFAULT-INCLUDES], [VALUE-IF-FAIL = -1])
# -------------------------------------------------------------------------------
# Defines CONST_EXPRESSION to the value of the compile-time EXPRESSION, using
=====================================
libraries/base/configure.ac
=====================================
@@ -126,6 +126,45 @@ AC_ARG_WITH([iconv-libraries],
AC_SUBST(ICONV_INCLUDE_DIRS)
AC_SUBST(ICONV_LIB_DIRS)
+
+# Compute offsets/sizes used by jsbits/base.js
+if test "$host" = "javascript-ghcjs"
+then
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_MODE], [stat], [st_mode], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_DEV], [stat], [st_dev], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_UID], [stat], [st_uid], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_GID], [stat], [st_gid], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_NLINK], [stat], [st_nlink], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_RDEV], [stat], [st_rdev], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_SIZE], [stat], [st_size], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_BLKSIZE], [stat], [st_blksize], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_BLOCKS], [stat], [st_blocks], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_INO], [stat], [st_ino], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_ATIME], [stat], [st_atime], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_MTIME], [stat], [st_mtime], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_CTIME], [stat], [st_ctime], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_MODE], [stat], [st_mode], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_DEV], [stat], [st_dev], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_UID], [stat], [st_uid], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_GID], [stat], [st_gid], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_NLINK], [stat], [st_nlink], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_RDEV], [stat], [st_rdev], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_SIZE], [stat], [st_size], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_BLKSIZE], [stat], [st_blksize], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_BLOCKS], [stat], [st_blocks], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_INO], [stat], [st_ino], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_ATIME], [stat], [st_atime], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_MTIME], [stat], [st_mtime], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_CTIME], [stat], [st_ctime], [#include <sys/stat.h>])
+ AC_CHECK_SIZEOF([struct stat], [], [#include <sys/stat.h>])
+
+ FP_COMPUTE_OFFSET([OFFSET_UTIMBUF_ACTIME], [utimbuf], [actime], [#include <utime.h>])
+ FP_COMPUTE_OFFSET([OFFSET_UTIMBUF_MODTIME], [utimbuf], [modtime], [#include <utime.h>])
+ FP_COMPUTE_SIZE([SIZEOF_UTIMBUF_ACTIME], [utimbuf], [actime], [#include <utime.h>])
+ FP_COMPUTE_SIZE([SIZEOF_UTIMBUF_MODTIME], [utimbuf], [modtime], [#include <utime.h>])
+ AC_CHECK_SIZEOF([struct utimbuf], [], [#include <utime.h>])
+fi
+
# map standard C types and ISO types to Haskell types
FPTOOLS_CHECK_HTYPE(char)
FPTOOLS_CHECK_HTYPE(signed char)
=====================================
libraries/base/jsbits/base.js
=====================================
@@ -435,18 +435,8 @@ function h$base_utime(file, file_off, timbuf, timbuf_off, c) {
if(err) {
h$handleErrnoC(err, 0, -1, c); // fixme
} else {
- h$long_from_number(fs.atime.getTime(), (h,l) => {
- timbuf.i3[0] = h;
- timbuf.i3[1] = l;
- });
- h$long_from_number(fs.mtime.getTime(), (h,l) => {
- timbuf.i3[2] = h;
- timbuf.i3[3] = l;
- });
- h$long_from_number(fs.ctime.getTime(), (h,l) => {
- timbuf.i3[4] = h;
- timbuf.i3[5] = l;
- });
+ h$base_store_field_number(timbuf, timbuf_off, OFFSET_UTIMBUF_ACTIME, SIZEOF_UTIMBUF_ACTIME, fs.atime.getTime());
+ h$base_store_field_number(timbuf, timbuf_off, OFFSET_UTIMBUF_MODTIME, SIZEOF_UTIMBUF_MODTIME, fs.mtime.getTime());
c(0);
}
});
@@ -507,85 +497,96 @@ function h$base_c_fcntl_lock(fd,cmd,ptr,ptr_o) {
// memory locations of structs directly. For more information see:
// https://gitlab.haskell.org/ghc/ghc/-/issues/22573
function h$base_fillStat(fs, b, off) {
- if(off%4) throw "h$base_fillStat: not aligned";
+ if(off%4) throw new Error("h$base_fillStat: not aligned");
var o = off>>2;
- b.i3[o+0] = fs.dev;
- b.i3[o+1] = 0; // __st_dev_padding;
- b.i3[o+2] = 0; // __st_ino_truncated;
- b.i3[o+3] = fs.mode;
- h$long_from_number(fs.nlink, (h,l) => {
- b.i3[o+4] = h;
- b.i3[o+5] = l;
- });
- b.i3[o+6] = fs.uid;
- b.i3[o+7] = fs.gid;
- b.i3[o+8] = fs.rdev;
- b.i3[o+9] = 0; // __st_rdev_padding;
- h$long_from_number(fs.size, (h,l) => {
- b.i3[o+10] = h;
- b.i3[o+11] = l;
- });
- b.i3[o+12] = fs.blksize;
- b.i3[o+13] = fs.blocks;
- atimeS = Math.floor(fs.atimeMs/1000);
- h$long_from_number(atimeS, (h,l) => {
- b.i3[o+14] = h;
- b.i3[o+15] = l;
- });
- atimeNs = (fs.atimeMs/1000 - atimeS) * 1000000000;
- h$long_from_number(atimeNs, (h,l) => {
- b.i3[o+16] = h;
- b.i3[o+17] = l;
- });
- mtimeS = Math.floor(fs.mtimeMs/1000);
- h$long_from_number(mtimeS, (h,l) => {
- b.i3[o+18] = h;
- b.i3[o+19] = l;
- });
- mtimeNs = (fs.mtimeMs/1000 - mtimeS) * 1000000000;
- h$long_from_number(mtimeNs, (h,l) => {
- b.i3[o+20] = h;
- b.i3[o+21] = l;
- });
- ctimeS = Math.floor(fs.ctimeMs/1000);
- h$long_from_number(ctimeS, (h,l) => {
- b.i3[o+22] = h;
- b.i3[o+23] = l;
- });
- ctimeNs = (fs.ctimeMs/1000 - ctimeS) * 1000000000;
- h$long_from_number(ctimeNs, (h,l) => {
- b.i3[o+24] = h;
- b.i3[o+25] = l;
- });
- h$long_from_number(fs.ino, (h,l) => {
- b.i3[o+26] = h;
- b.i3[o+27] = l;
- });
+ // clear memory
+ for(var i=0;i<(SIZEOF_STRUCT_STAT>>2);i++) {
+ b.i3[o+i] = 0;
+ }
+
+ // fill struct
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_DEV, SIZEOF_STAT_ST_DEV, fs.dev);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_MODE, SIZEOF_STAT_ST_MODE, fs.mode);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_NLINK, SIZEOF_STAT_ST_NLINK, fs.nlink);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_UID, SIZEOF_STAT_ST_UID, fs.uid);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_GID, SIZEOF_STAT_ST_GID, fs.gid);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_RDEV, SIZEOF_STAT_ST_RDEV, fs.rdev);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_SIZE, SIZEOF_STAT_ST_SIZE, fs.size);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_BLKSIZE, SIZEOF_STAT_ST_BLKSIZE, fs.blksize);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_BLOCKS, SIZEOF_STAT_ST_BLOCKS, fs.blocks);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_INO, SIZEOF_STAT_ST_INO, fs.ino);
+
+ var atimeS = Math.floor(fs.atimeMs/1000);
+ var atimeNs = (fs.atimeMs/1000 - atimeS) * 1000000000;
+ h$base_store_field_number_2(b, off, OFFSET_STAT_ST_ATIME, SIZEOF_STAT_ST_ATIME, atimeS, atimeNs);
+ var mtimeS = Math.floor(fs.mtimeMs/1000);
+ var mtimeNs = (fs.mtimeMs/1000 - mtimeS) * 1000000000;
+ h$base_store_field_number_2(b, off, OFFSET_STAT_ST_MTIME, SIZEOF_STAT_ST_MTIME, mtimeS, mtimeNs);
+ var ctimeS = Math.floor(fs.ctimeMs/1000);
+ var ctimeNs = (fs.ctimeMs/1000 - ctimeS) * 1000000000;
+ h$base_store_field_number_2(b, off, OFFSET_STAT_ST_CTIME, SIZEOF_STAT_ST_CTIME, ctimeS, ctimeNs);
}
#endif
-// [mode,size1,size2,mtime1,mtime2,dev,ino1,ino2,uid,gid] all 32 bit
-/** @const */ var h$base_sizeof_stat = 112;
+function h$base_store_field_number(ptr, ptr_off, field_off, field_size, val) {
+ if(ptr_off%4) throw new Error("ptr not aligned");
+ if(field_off%4) throw new Error("field not aligned");
+ if(typeof val !== 'number') throw new Error("not a number: " + val);
+ if(field_size === 4) {
+ ptr.i3[(ptr_off>>2)+(field_off>>2)] = val;
+ } else if(field_size === 8) {
+ h$long_from_number(val, (h,l) => {
+ ptr.i3[(ptr_off>>2)+(field_off>>2)] = h;
+ ptr.i3[(ptr_off>>2)+(field_off>>2)+1] = l;
+ });
+ } else {
+ throw new Error("unsupported field size: " + field_size);
+ }
+}
+
+function h$base_store_field_number_2(ptr, ptr_off, field_off, field_size, val1, val2) {
+ if(field_size%2) throw new Error("unsupported field size: " + field_size);
+ var half_field_size = field_size>>1;
+ h$base_store_field_number(ptr, ptr_off, field_off, half_field_size, val1);
+ h$base_store_field_number(ptr, ptr_off, field_off+half_field_size, half_field_size, val2);
+}
+
+function h$base_return_field(ptr, ptr_off, field_off, field_size) {
+ if(ptr_off%4) throw new Error("ptr not aligned");
+ if(field_off%4) throw new Error("field not aligned");
+ if(field_size === 4) {
+ return ptr.i3[(ptr_off>>2) + (field_off>>2)];
+ } else if(field_size === 8) {
+ RETURN_UBX_TUP2(ptr.i3[(ptr_off>>2) + (field_off>>2)], ptr.i3[(ptr_off>>2) + (field_off>>2)+1]);
+ } else {
+ throw new Error("unsupported field size: " + field_size);
+ }
+}
+
+function h$base_sizeof_stat() {
+ return SIZEOF_STRUCT_STAT;
+}
function h$base_st_mtime(stat, stat_off) {
- RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+18], stat.i3[(stat_off>>2)+19]);
+ // XXX should we use the nanoseconds?
+ return h$base_return_field(stat, stat_off, OFFSET_STAT_ST_MTIME, SIZEOF_STAT_ST_MTIME);
}
function h$base_st_size(stat, stat_off) {
- RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+10], stat.i3[(stat_off>>2)+11]);
+ return h$base_return_field(stat, stat_off, OFFSET_STAT_ST_SIZE, SIZEOF_STAT_ST_SIZE);
}
function h$base_st_mode(stat, stat_off) {
- return stat.i3[(stat_off>>2)+3];
+ return h$base_return_field(stat, stat_off, OFFSET_STAT_ST_MODE, SIZEOF_STAT_ST_MODE);
}
function h$base_st_dev(stat, stat_off) {
- return stat.i3[(stat_off>>2)+0];
+ return h$base_return_field(stat, stat_off, OFFSET_STAT_ST_DEV, SIZEOF_STAT_ST_DEV);
}
function h$base_st_ino(stat, stat_off) {
- RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+26], stat.i3[(stat_off>>2)+27]);
+ return h$base_return_field(stat, stat_off, OFFSET_STAT_ST_INO, SIZEOF_STAT_ST_INO);
}
/** @const */ var h$base_echo = 1;
=====================================
m4/emsdk_version.m4
=====================================
@@ -0,0 +1,42 @@
+dnl EMSDK_VERSION()
+dnl ---------------
+dnl
+dnl Check the version of emsdk, if we're building the JavaScript backend
+dnl (the test is skipped if the target is not JavaScript)
+dnl
+dnl If you change the version requirements, please also update:
+dnl https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation/tools
+dnl
+dnl $1 = minimum version (inclusive), or "" for no minimum
+dnl $2 = maximum version (not inclusive), or "" for no maximum
+dnl $3 = exact version required, or "" for no exact version (used for bindist)
+
+AC_DEFUN([EMSDK_VERSION],
+[
+ if test "$TargetArch_CPP" = "javascript"
+ then
+ AC_MSG_CHECKING(emsdk version)
+ EmsdkVersion=`$CC -v 2>&1 | sed -n -e 's/^emcc[[^0-9]]*\([[0-9.]]*\).*/\1/gp'`
+ if test "$EmsdkVersion" = ""
+ then
+ AC_MSG_ERROR([could not determine emsdk version. Perhaps CC is not emcc?])
+ else
+ AC_MSG_RESULT($EmsdkVersion)
+ if test "$1" != ""
+ then
+ FP_COMPARE_VERSIONS([$EmsdkVersion],[-lt],[$1],
+ [AC_MSG_ERROR([emsdk version $1 or later is required to compile the GHC JavaScript backend.])])[]
+ fi
+ if test "$2" != ""
+ then
+ FP_COMPARE_VERSIONS([$EmsdkVersion],[-ge],[$2],
+ [AC_MSG_ERROR([emsdk version earlier than $2 is required to compile the GHC JavaScript backend.])])[]
+ fi
+ if test "$3" != ""
+ then
+ FP_COMPARE_VERSIONS([$EmsdkVersion],[-ne],[$3],
+ [AC_MSG_ERROR([emsdk version $3 is required for this build of GHC])])[]
+ fi
+ fi
+ fi
+])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa07402e9ba5a302ada9b3cecebf7fdc00aa31dd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa07402e9ba5a302ada9b3cecebf7fdc00aa31dd
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230807/ab4867c1/attachment-0001.html>
More information about the ghc-commits
mailing list