From e4791671dcfe3baae97a3f5f6bc582e0f9d7d292 Mon Sep 17 00:00:00 2001 From: Cheng Shao Date: Sat, 4 Dec 2021 02:24:56 +0100 Subject: [PATCH] 32-bit codegen (#876) --- .github/workflows/shell.yml | 5 +- asterius/boot.sh | 62 +- asterius/package.yaml | 3 +- asterius/rts/node/rts.fs.mjs | 15 +- asterius/rts/rts.autoapply.mjs | 31 +- asterius/rts/rts.constants.mjs | 162 +- asterius/rts/rts.exception.mjs | 53 +- asterius/rts/rts.gc.mjs | 272 +-- asterius/rts/rts.heapalloc.mjs | 31 +- asterius/rts/rts.jsval.mjs | 2 +- asterius/rts/rts.memory.mjs | 30 +- asterius/rts/rts.memorytrap.mjs | 40 +- asterius/rts/rts.scheduler.mjs | 54 +- asterius/rts/rts.stablename.mjs | 10 +- asterius/rts/rts.stableptr.mjs | 9 +- asterius/rts/rts.typecheck.mjs | 9 + asterius/src-types/Asterius/Types.hs | 10 +- asterius/src/Asterius/Backends/Binaryen.hs | 29 +- asterius/src/Asterius/Binary/File.hs | 2 +- asterius/src/Asterius/Builtins.hs | 669 +++---- asterius/src/Asterius/Builtins/Barf.hs | 14 +- asterius/src/Asterius/Builtins/Blackhole.hs | 68 +- asterius/src/Asterius/Builtins/Env.hs | 11 +- asterius/src/Asterius/Builtins/Exports.hs | 31 +- asterius/src/Asterius/Builtins/Posix.hs | 259 +-- asterius/src/Asterius/Builtins/SM.hs | 36 +- asterius/src/Asterius/Builtins/Scheduler.hs | 14 +- asterius/src/Asterius/Builtins/Sparks.hs | 6 +- asterius/src/Asterius/Builtins/Time.hs | 88 +- asterius/src/Asterius/CodeGen.hs | 416 ++-- asterius/src/Asterius/EDSL.hs | 8 +- .../src/Asterius/Foreign/SupportedTypes.hs | 6 +- asterius/src/Asterius/FrontendPlugin.hs | 13 +- asterius/src/Asterius/GHCi/Internals.hs | 1 - asterius/src/Asterius/Internals.hs | 3 - .../src/Asterius/Internals/MagicNumber.hs | 6 +- asterius/src/Asterius/Internals/Temp.hs | 1 - asterius/src/Asterius/JSFFI.hs | 56 +- asterius/src/Asterius/JSRun/NonMain.hs | 1 - asterius/src/Asterius/Main.hs | 5 +- asterius/src/Asterius/Main/Task.hs | 4 +- asterius/src/Asterius/MemoryTrap.hs | 12 +- asterius/src/Asterius/Passes/CCall.hs | 13 +- .../src/Asterius/Passes/DataOffsetTable.hs | 4 +- asterius/src/Asterius/Passes/GCSections.hs | 2 - asterius/src/Asterius/Passes/GlobalRegs.hs | 50 +- asterius/src/Asterius/Passes/Relooper.hs | 111 ++ asterius/src/Asterius/Resolve.hs | 5 +- asterius/src/Asterius/TypeInfer.hs | 10 +- ghc-toolkit/cbits/ghc_constants.c | 817 ++++---- ghc-toolkit/package.yaml | 1 - .../Language/Haskell/GHC/Toolkit/Constants.hs | 1711 +++++++++++------ cabal.project.nix => nix.cabal.project | 8 +- nix/ghcconstants.nix | 27 + nix/libghcconstants.nix | 17 - nix/{pkg-set.nix => project.nix} | 12 +- nix/sources.json | 36 +- nix/sources.nix | 17 +- shell.nix | 11 +- 59 files changed, 2827 insertions(+), 2582 deletions(-) create mode 100644 asterius/rts/rts.typecheck.mjs create mode 100644 asterius/src/Asterius/Passes/Relooper.hs rename cabal.project.nix => nix.cabal.project (79%) create mode 100644 nix/ghcconstants.nix delete mode 100644 nix/libghcconstants.nix rename nix/{pkg-set.nix => project.nix} (63%) diff --git a/.github/workflows/shell.yml b/.github/workflows/shell.yml index 7c667142..dfc7d93b 100644 --- a/.github/workflows/shell.yml +++ b/.github/workflows/shell.yml @@ -22,11 +22,12 @@ jobs: submodules: recursive - name: setup-nix - uses: cachix/install-nix-action@v14.1 + uses: cachix/install-nix-action@v16 with: extra_nix_config: | substituters = https://cache.nixos.org https://hydra.iohk.io trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= + install_url: https://releases.nixos.org/nix/nix-2.3.16/install - name: setup-cachix uses: cachix/cachix-action@v10 @@ -36,7 +37,7 @@ jobs: - name: cachix-watch-store run: | - cachix watch-store -c9 asterius & + cachix watch-store -c9 -j2 asterius & - name: shell run: | diff --git a/asterius/boot.sh b/asterius/boot.sh index f6983de1..b814dc59 100755 --- a/asterius/boot.sh +++ b/asterius/boot.sh @@ -28,12 +28,12 @@ cp "$AHC_SRCDIR"/ghc-toolkit/boot-libs/rts/rts.conf "$AHC_LIBDIR"/package.conf.d ahc-pkg --global recache mkdir "$AHC_LIBDIR"/rts -find "$AHC_TMPDIR"/rts -name '*.cmm' -exec sh -c 'ahc -c -O2 -dcmm-lint -I"$AHC_LIBDIR"/include -this-unit-id rts -o "$AHC_TMPDIR"/rts/$(basename "$0" .cmm).o "$0"' {} \; +find "$AHC_TMPDIR"/rts -name '*.cmm' -print0 | xargs -0 -n1 sh -c 'ahc -c -O2 -dcmm-lint -I"$AHC_LIBDIR"/include -this-unit-id rts -o "$AHC_TMPDIR"/rts/$(basename "$0" .cmm).o "$0"' ar qDS "$AHC_LIBDIR"/rts/libHSrts.a "$AHC_TMPDIR"/rts/*.o pushd "$AHC_TMPDIR" -ASTERIUS_CONFIGURE_OPTIONS="--disable-shared --disable-profiling --disable-debug-info --disable-library-for-ghci --disable-split-objs --disable-split-sections --disable-library-stripping --disable-relocatable -O2 --prefix=$AHC_LIBDIR --global --ipid=\$pkg --with-compiler=ahc --with-hc-pkg=ahc-pkg --hsc2hs-option=--cross-safe --ghc-option=-v1 --ghc-option=-dsuppress-ticks" +ASTERIUS_CONFIGURE_OPTIONS="--disable-shared --disable-profiling --disable-debug-info --disable-library-for-ghci --disable-split-objs --disable-split-sections --disable-library-stripping --disable-relocatable -O2 --prefix=$AHC_LIBDIR --global --ipid=\$pkg --with-compiler=ahc --with-hc-pkg=ahc-pkg --with-ar=ar --hsc2hs-option=--cross-compile --ghc-option=-v1 --ghc-option=-dsuppress-ticks" pushd ghc-prim Setup-ghc-prim configure $ASTERIUS_CONFIGURE_OPTIONS @@ -53,6 +53,48 @@ ahc-cabal act-as-setup --build-type=Configure -- build -j ahc-cabal act-as-setup --build-type=Configure -- install popd +pushd array +ahc-cabal act-as-setup --build-type=Simple -- configure $ASTERIUS_CONFIGURE_OPTIONS +ahc-cabal act-as-setup --build-type=Simple -- build -j +ahc-cabal act-as-setup --build-type=Simple -- install +popd + +pushd deepseq +ahc-cabal act-as-setup --build-type=Simple -- configure $ASTERIUS_CONFIGURE_OPTIONS +ahc-cabal act-as-setup --build-type=Simple -- build -j +ahc-cabal act-as-setup --build-type=Simple -- install +popd + +pushd bytestring +ahc-cabal act-as-setup --build-type=Simple -- configure $ASTERIUS_CONFIGURE_OPTIONS +ahc-cabal act-as-setup --build-type=Simple -- build -j +ahc-cabal act-as-setup --build-type=Simple -- install +popd + +pushd time +ahc-cabal act-as-setup --build-type=Configure -- configure $ASTERIUS_CONFIGURE_OPTIONS +ahc-cabal act-as-setup --build-type=Configure -- build -j +ahc-cabal act-as-setup --build-type=Configure -- install +popd + +pushd unix +ahc-cabal act-as-setup --build-type=Configure -- configure --ghc-option=-this-unit-id=unix $ASTERIUS_CONFIGURE_OPTIONS +ahc-cabal act-as-setup --build-type=Configure -- build -j +ahc-cabal act-as-setup --build-type=Configure -- install +popd + +pushd filepath +ahc-cabal act-as-setup --build-type=Simple -- configure --ghc-option=-this-unit-id=filepath $ASTERIUS_CONFIGURE_OPTIONS +ahc-cabal act-as-setup --build-type=Simple -- build -j +ahc-cabal act-as-setup --build-type=Simple -- install +popd + +pushd directory +ahc-cabal act-as-setup --build-type=Configure -- configure --ghc-option=-this-unit-id=directory $ASTERIUS_CONFIGURE_OPTIONS +ahc-cabal act-as-setup --build-type=Configure -- build -j +ahc-cabal act-as-setup --build-type=Configure -- install +popd + pushd ghc-heap ahc-cabal act-as-setup --build-type=Simple -- configure $ASTERIUS_CONFIGURE_OPTIONS ahc-cabal act-as-setup --build-type=Simple -- build -j @@ -67,24 +109,8 @@ popd ahc-cabal update || true -ahc-cabal v1-install --allow-newer $ASTERIUS_CONFIGURE_OPTIONS array-0.5.4.0 - -ahc-cabal v1-install $ASTERIUS_CONFIGURE_OPTIONS \ - bytestring-0.10.12.0 \ - deepseq-1.4.5.0 \ - time-1.9.3 - -pushd $(mktemp -d) -ahc-cabal get unix-2.7.2.2 -cd unix-2.7.2.2 -ahc-cabal act-as-setup --build-type=Configure -- configure --ghc-option=-this-unit-id=unix $ASTERIUS_CONFIGURE_OPTIONS -ahc-cabal act-as-setup --build-type=Configure -- build -j -ahc-cabal act-as-setup --build-type=Configure -- install -popd - ahc-cabal v1-install $ASTERIUS_CONFIGURE_OPTIONS \ binary-0.8.8.0 \ - directory-1.3.6.0 \ mtl-2.2.2 \ pretty-1.1.3.6 diff --git a/asterius/package.yaml b/asterius/package.yaml index efaf5bba..5e700032 100644 --- a/asterius/package.yaml +++ b/asterius/package.yaml @@ -45,7 +45,7 @@ extra-source-files: ghc-options: -Wall _exe-ghc-options: &exe-ghc-options - - -threaded -rtsopts "-with-rtsopts=-H512m -I0 -qg" + - -rtsopts dependencies: - base @@ -55,6 +55,7 @@ dependencies: - containers - deepseq - directory + - exceptions - filepath - ghc-asterius - ghc-boot-asterius diff --git a/asterius/rts/node/rts.fs.mjs b/asterius/rts/node/rts.fs.mjs index 2b51db63..9ee48f62 100644 --- a/asterius/rts/node/rts.fs.mjs +++ b/asterius/rts/node/rts.fs.mjs @@ -1,5 +1,6 @@ import fs from "fs"; import { Memory } from "./rts.memory.mjs"; +import { isI32 } from "./rts.typecheck.mjs"; class Device { constructor(f, console_history) { @@ -37,21 +38,27 @@ export class FS { } read(fd, buf, count) { + isI32(fd); + isI32(buf); + isI32(count); const p = buf; - return fs.readSync(fd, this.components.memory.i8View, p, count, null); + return isI32(fs.readSync(fd, this.components.memory.i8View, p, count, null)); } write(fd, buf, count) { + isI32(fd); + isI32(buf); + isI32(count); buf = this.components.memory.expose(buf, count, Uint8Array); switch (fd) { case 1: { - return this.stdout.write(buf); + return isI32(this.stdout.write(buf)); } case 2: { - return this.stderr.write(buf); + return isI32(this.stderr.write(buf)); } default: { - return fs.writeSync(fd, buf); + return isI32(fs.writeSync(fd, buf)); } } } diff --git a/asterius/rts/rts.autoapply.mjs b/asterius/rts/rts.autoapply.mjs index f772f15a..34dc3d60 100644 --- a/asterius/rts/rts.autoapply.mjs +++ b/asterius/rts/rts.autoapply.mjs @@ -1,31 +1,4 @@ export const stg_arg_bitmaps = [ - 0, - 0, - 0, - 0, - 65, - 1, - 65, - 65, - 65, - 194, - 964, - 16328, - 194, - 66, - 130, - 2, - 451, - 195, - 323, - 67, - 387, - 131, - 259, - 3, - 4, - 5, - 6, - 7, - 8 + 0, 0, 0, 0, 33, 1, 33, 98, 98, 484, 8168, 2097136, 98, 34, 66, 2, 227, 99, + 163, 35, 195, 67, 131, 3, 4, 5, 6, 7, 8, ]; diff --git a/asterius/rts/rts.constants.mjs b/asterius/rts/rts.constants.mjs index 1f6f1030..17821ae4 100644 --- a/asterius/rts/rts.constants.mjs +++ b/asterius/rts/rts.constants.mjs @@ -1,102 +1,102 @@ export const mblock_size = 0x100000; export const mblock_size_log2 = 0x14; export const block_size = 0x1000; -export const blocks_per_mblock = 0xfc; +export const blocks_per_mblock = 0xfe; export const offset_timespec_tv_sec = 0x0; export const offset_timespec_tv_nsec = 0x8; -export const sizeof_bdescr = 0x40; -export const offset_first_bdescr = 0x100; -export const offset_first_block = 0x4000; -export const sizeof_first_mblock = 0xfc000; +export const sizeof_bdescr = 0x20; +export const offset_first_bdescr = 0x40; +export const offset_first_block = 0x2000; +export const sizeof_first_mblock = 0xfe000; export const offset_bdescr_start = 0x0; -export const offset_bdescr_free = 0x8; -export const offset_bdescr_link = 0x10; -export const offset_bdescr_gen_no = 0x28; -export const offset_bdescr_node = 0x2c; -export const offset_bdescr_flags = 0x2e; -export const offset_bdescr_blocks = 0x30; +export const offset_bdescr_free = 0x4; +export const offset_bdescr_link = 0x8; +export const offset_bdescr_gen_no = 0x14; +export const offset_bdescr_node = 0x18; +export const offset_bdescr_flags = 0x1a; +export const offset_bdescr_blocks = 0x1c; export const BF_PINNED = 0x4; export const pageSize = 65536; -export const offset_Capability_r = 0x18; -export const sizeof_StgAP = 0x20; -export const offset_StgAP_arity = 0x10; -export const offset_StgAP_n_args = 0x14; -export const offset_StgAP_fun = 0x18; -export const offset_StgAP_payload = 0x20; -export const sizeof_StgAP_STACK = 0x20; -export const offset_StgAP_STACK_size = 0x10; -export const offset_StgAP_STACK_fun = 0x18; -export const offset_StgAP_STACK_payload = 0x20; -export const sizeof_StgArrBytes = 0x10; -export const offset_StgArrBytes_bytes = 0x8; +export const offset_Capability_r = 0x10; +export const sizeof_StgAP = 0x10; +export const offset_StgAP_arity = 0x8; +export const offset_StgAP_n_args = 0xa; +export const offset_StgAP_fun = 0xc; +export const offset_StgAP_payload = 0x10; +export const sizeof_StgAP_STACK = 0x10; +export const offset_StgAP_STACK_size = 0x8; +export const offset_StgAP_STACK_fun = 0xc; +export const offset_StgAP_STACK_payload = 0x10; +export const sizeof_StgArrBytes = 0x8; +export const offset_StgArrBytes_bytes = 0x4; export const offset_StgFunInfoExtraFwd_fun_type = 0x0; -export const offset_StgFunInfoExtraFwd_srt = 0x8; -export const offset_StgFunInfoExtraFwd_b = 0x10; +export const offset_StgFunInfoExtraFwd_srt = 0x4; +export const offset_StgFunInfoExtraFwd_b = 0x8; export const offset_StgFunInfoTable_i = 0x0; -export const offset_StgFunInfoTable_f = 0x18; -export const sizeof_StgInd = 0x10; -export const offset_StgInd_indirectee = 0x8; -export const sizeof_StgIndStatic = 0x20; -export const offset_StgIndStatic_indirectee = 0x8; -export const offset_StgInfoTable_layout = 0x8; -export const offset_StgInfoTable_type = 0x10; -export const offset_StgInfoTable_srt = 0x14; +export const offset_StgFunInfoTable_f = 0xc; +export const sizeof_StgInd = 0x8; +export const offset_StgInd_indirectee = 0x4; +export const sizeof_StgIndStatic = 0x10; +export const offset_StgIndStatic_indirectee = 0x4; +export const offset_StgInfoTable_layout = 0x4; +export const offset_StgInfoTable_type = 0x8; +export const offset_StgInfoTable_srt = 0xa; export const offset_StgLargeBitmap_size = 0x0; -export const offset_StgLargeBitmap_bitmap = 0x8; -export const sizeof_StgMutArrPtrs = 0x18; -export const offset_StgMutArrPtrs_ptrs = 0x8; -export const offset_StgMutArrPtrs_payload = 0x18; -export const offset_StgMVar_head = 0x8; -export const offset_StgMVar_tail = 0x10; -export const offset_StgMVar_value = 0x18; -export const sizeof_StgPAP = 0x18; -export const offset_StgPAP_arity = 0x8; -export const offset_StgPAP_n_args = 0xc; -export const offset_StgPAP_fun = 0x10; -export const offset_StgPAP_payload = 0x18; +export const offset_StgLargeBitmap_bitmap = 0x4; +export const sizeof_StgMutArrPtrs = 0xc; +export const offset_StgMutArrPtrs_ptrs = 0x4; +export const offset_StgMutArrPtrs_payload = 0xc; +export const offset_StgMVar_head = 0x4; +export const offset_StgMVar_tail = 0x8; +export const offset_StgMVar_value = 0xc; +export const sizeof_StgPAP = 0xc; +export const offset_StgPAP_arity = 0x4; +export const offset_StgPAP_n_args = 0x6; +export const offset_StgPAP_fun = 0x8; +export const offset_StgPAP_payload = 0xc; export const offset_StgRegTable_rR1 = 0x0; -export const offset_StgRegTable_rF1 = 0x50; -export const offset_StgRegTable_rD1 = 0x68; -export const offset_StgRegTable_rCurrentNursery = 0x378; -export const offset_StgRegTable_rHpAlloc = 0x388; -export const offset_StgRegTable_rRet = 0x390; -export const sizeof_StgRetFun = 0x18; -export const offset_StgRetFun_size = 0x8; -export const offset_StgRetFun_fun = 0x10; -export const offset_StgRetFun_payload = 0x18; +export const offset_StgRegTable_rF1 = 0x28; +export const offset_StgRegTable_rD1 = 0x40; +export const offset_StgRegTable_rCurrentNursery = 0x334; +export const offset_StgRegTable_rHpAlloc = 0x33c; +export const offset_StgRegTable_rRet = 0x340; +export const sizeof_StgRetFun = 0xc; +export const offset_StgRetFun_size = 0x4; +export const offset_StgRetFun_fun = 0x8; +export const offset_StgRetFun_payload = 0xc; export const offset_StgRetInfoTable_i = 0x0; -export const offset_StgRetInfoTable_srt = 0x18; -export const sizeof_StgSelector = 0x18; -export const offset_StgSelector_selectee = 0x10; -export const sizeof_StgSmallMutArrPtrs = 0x10; -export const offset_StgSmallMutArrPtrs_ptrs = 0x8; -export const offset_StgSmallMutArrPtrs_payload = 0x10; -export const sizeof_StgThunk = 0x10; -export const offset_StgThunk_payload = 0x10; +export const offset_StgRetInfoTable_srt = 0xc; +export const sizeof_StgSelector = 0xc; +export const offset_StgSelector_selectee = 0x8; +export const sizeof_StgSmallMutArrPtrs = 0x8; +export const offset_StgSmallMutArrPtrs_ptrs = 0x4; +export const offset_StgSmallMutArrPtrs_payload = 0x8; +export const sizeof_StgThunk = 0x8; +export const offset_StgThunk_payload = 0x8; export const offset_StgThunkInfoTable_i = 0x0; -export const offset_StgThunkInfoTable_srt = 0x18; -export const offset_StgTSO_id = 0x30; -export const offset_StgTSO_stackobj = 0x18; -export const offset_StgTSO_what_next = 0x20; -export const offset_StgTSO_why_blocked = 0x22; -export const offset_StgTSO_block_info = 0x28; -export const offset_StgStack_stack_size = 0x8; -export const offset_StgStack_sp = 0x10; -export const offset_StgStack_stack = 0x18; -export const offset_StgUpdateFrame_updatee = 0x8; -export const offset_StgWeak_cfinalizers = 0x8; -export const offset_StgWeak_key = 0x10; -export const offset_StgWeak_value = 0x18; -export const offset_StgWeak_finalizer = 0x20; -export const offset_StgWeak_link = 0x28; -export const sizeof_StgStableName = 0x10; +export const offset_StgThunkInfoTable_srt = 0xc; +export const offset_StgTSO_id = 0x1c; +export const offset_StgTSO_stackobj = 0xc; +export const offset_StgTSO_what_next = 0x10; +export const offset_StgTSO_why_blocked = 0x12; +export const offset_StgTSO_block_info = 0x18; +export const offset_StgStack_stack_size = 0x4; +export const offset_StgStack_sp = 0xc; +export const offset_StgStack_stack = 0x10; +export const offset_StgUpdateFrame_updatee = 0x4; +export const offset_StgWeak_cfinalizers = 0x4; +export const offset_StgWeak_key = 0x8; +export const offset_StgWeak_value = 0xc; +export const offset_StgWeak_finalizer = 0x10; +export const offset_StgWeak_link = 0x14; +export const sizeof_StgStableName = 0x8; export const offset_StgStableName_header = 0x0; -export const offset_StgStableName_sn = 0x8; +export const offset_StgStableName_sn = 0x4; export const offset_stat_mtime = 0x58; export const offset_stat_size = 0x30; export const offset_stat_mode = 0x18; export const offset_stat_dev = 0x0; export const offset_stat_ino = 0x8; -export const clock_monotonic = 0x1; -export const clock_realtime = 0x0; +export const clock_monotonic = 0x404; +export const clock_realtime = 0x400; export const hsTyCons = ["JSVal","Bool","Char","Double","Float","Int","Int8","Int16","Int32","Int64","Word","Word8","Word16","Word32","Word64","StablePtr","Ptr","FunPtr"]; diff --git a/asterius/rts/rts.exception.mjs b/asterius/rts/rts.exception.mjs index 25a3a74d..7700ae48 100644 --- a/asterius/rts/rts.exception.mjs +++ b/asterius/rts/rts.exception.mjs @@ -1,6 +1,6 @@ import * as ClosureTypes from "./rts.closuretypes.mjs"; import * as rtsConstants from "./rts.constants.mjs"; -import { Memory } from "./rts.memory.mjs"; +import { isI32 } from "./rts.typecheck.mjs"; /* The methods of this class are related to exception handling in Haskell. @@ -30,29 +30,32 @@ export class ExceptionHelper { the frame type is returned to `stg_raisezh` for further processing. */ raiseExceptionHelper(reg, tso, exception) { + isI32(reg); + isI32(tso); + isI32(exception); const raise_closure = this.heapAlloc.allocate( - Math.ceil(rtsConstants.sizeof_StgThunk / 8) + 1 + Math.ceil(rtsConstants.sizeof_StgThunk / 4) + 1 ); - this.memory.i64Store( + this.memory.i32Store( raise_closure, this.symbolTable.addressOf("stg_raise_info") ); - this.memory.i64Store( + this.memory.i32Store( raise_closure + rtsConstants.offset_StgThunk_payload, exception ); - const stackobj = Number( - this.memory.i64Load(tso + rtsConstants.offset_StgTSO_stackobj) + const stackobj = ( + this.memory.i32Load(tso + rtsConstants.offset_StgTSO_stackobj) ); - let p = Number( - this.memory.i64Load(stackobj + rtsConstants.offset_StgStack_sp) + let p = ( + this.memory.i32Load(stackobj + rtsConstants.offset_StgStack_sp) ); while (true) { - const info = Number(this.memory.i64Load(p)), + const info = (this.memory.i32Load(p)), type = this.memory.i32Load( info + rtsConstants.offset_StgInfoTable_type ), - raw_layout = this.memory.i64Load( + raw_layout = this.memory.i32Load( info + rtsConstants.offset_StgInfoTable_layout ); if (this.infoTables && !this.infoTables.has(info)) @@ -61,8 +64,8 @@ export class ExceptionHelper { ); switch (type) { case ClosureTypes.UPDATE_FRAME: { - const p1 = Number( - this.memory.i64Load(p + rtsConstants.offset_StgUpdateFrame_updatee) + const p1 = ( + this.memory.i32Load(p + rtsConstants.offset_StgUpdateFrame_updatee) ); this.exports.updateThunk( this.symbolTable.addressOf("MainCapability"), @@ -70,34 +73,34 @@ export class ExceptionHelper { p1, raise_closure ); - const size = Number(raw_layout & BigInt(0x3f)); - p += (1 + size) << 3; + const size = (raw_layout & (0x1f)); + p += (1 + size) << 2; break; } case ClosureTypes.CATCH_FRAME: case ClosureTypes.STOP_FRAME: { - this.memory.i64Store(stackobj + rtsConstants.offset_StgStack_sp, p); - return type; + this.memory.i32Store(stackobj + rtsConstants.offset_StgStack_sp, p); + return isI32(type); } case ClosureTypes.RET_SMALL: { - const size = Number(raw_layout & BigInt(0x3f)); - p += (1 + size) << 3; + const size = (raw_layout & (0x1f)); + p += (1 + size) << 2; break; } case ClosureTypes.RET_BIG: { - const size = Number( - this.memory.i64Load( - Number(raw_layout) + rtsConstants.offset_StgLargeBitmap_size + const size = ( + this.memory.i32Load( + (raw_layout) + rtsConstants.offset_StgLargeBitmap_size ) ); - p += (1 + size) << 3; + p += (1 + size) << 2; break; } case ClosureTypes.RET_FUN: { - const size = Number( - this.memory.i64Load(p + rtsConstants.offset_StgRetFun_size) + const size = ( + this.memory.i32Load(p + rtsConstants.offset_StgRetFun_size) ); - p += rtsConstants.sizeof_StgRetFun + (size << 3); + p += rtsConstants.sizeof_StgRetFun + (size << 2); break; } default: diff --git a/asterius/rts/rts.gc.mjs b/asterius/rts/rts.gc.mjs index ab3fc9f6..bac75189 100644 --- a/asterius/rts/rts.gc.mjs +++ b/asterius/rts/rts.gc.mjs @@ -11,7 +11,7 @@ import { JSValManager } from "./rts.jsval.mjs"; * @param c The closure address */ function bdescr(c) { - const nc = Number(c); + const nc = (c); return nc - (nc & (rtsConstants.mblock_size - 1)) + rtsConstants.offset_first_bdescr; } @@ -123,7 +123,7 @@ export class GC { * @param bytes The size in bytes of the closure */ copyClosure(c, bytes) { - const dest_c = this.heapAlloc.allocate(Math.ceil(bytes / 8)); + const dest_c = this.heapAlloc.allocate(Math.ceil(bytes / 4)); this.memory.memcpy(dest_c, c, bytes); const dest_block = bdescr(dest_c); if (!this.liveMBlocks.has(dest_block)) { @@ -155,7 +155,7 @@ export class GC { if (!untagged_c) { // If no information about c is present, compute it untagged_c = Memory.unDynTag(c); - info = Number(this.memory.i64Load(untagged_c)); + info = (this.memory.i32Load(untagged_c)); if (info % 2 == 0) { // Obtain the closure type only if the header // is an info pointer and not a forwarding pointer @@ -167,31 +167,31 @@ export class GC { switch (type) { case ClosureTypes.IND: { // Whitehole - this.memory.i64Store( + this.memory.i32Store( untagged_c, this.symbolTable.addressOf("stg_WHITEHOLE_info") ); // Follow the indirectee const [res_c, _] = this.stingyEval( - Number( - this.memory.i64Load( + ( + this.memory.i32Load( untagged_c + rtsConstants.offset_StgInd_indirectee ) )); - this.memory.i64Store(untagged_c, this.symbolTable.addressOf("stg_IND_info")); // Undo whiteholing - this.memory.i64Store(untagged_c + rtsConstants.offset_StgInd_indirectee, res_c); + this.memory.i32Store(untagged_c, this.symbolTable.addressOf("stg_IND_info")); // Undo whiteholing + this.memory.i32Store(untagged_c + rtsConstants.offset_StgInd_indirectee, res_c); return [res_c, ClosureTypes.IND]; } case ClosureTypes.THUNK_SELECTOR: { // Whitehole - this.memory.i64Store( + this.memory.i32Store( untagged_c, this.symbolTable.addressOf("stg_WHITEHOLE_info") ); // Follow the selectee const [res_c, res_type] = this.stingyEval( - Number( - this.memory.i64Load( + ( + this.memory.i32Load( untagged_c + rtsConstants.offset_StgSelector_selectee )) ); @@ -205,10 +205,10 @@ export class GC { ); // Warning: at this point (and in the similar point below) // we may be losing the dynamic tagging, fixme - const selectee = this.memory.i64Load( - Memory.unDynTag(res_c) + ((1 + offset) << 3) + const selectee = this.memory.i32Load( + Memory.unDynTag(res_c) + ((1 + offset) << 2) ); - this.memory.i64Store(untagged_c + rtsConstants.offset_StgInd_indirectee, selectee); + this.memory.i32Store(untagged_c + rtsConstants.offset_StgInd_indirectee, selectee); // Set the current closure as IND, but do not // un-whitehole for now: it will be taken care // of later, when propagating the result @@ -217,16 +217,16 @@ export class GC { } case ClosureTypes.CONSTR_1_0: case ClosureTypes.CONSTR_1_1: { - const selectee = this.memory.i64Load(Memory.unDynTag(res_c) + 8); - this.memory.i64Store( + const selectee = this.memory.i32Load(Memory.unDynTag(res_c) + 4); + this.memory.i32Store( untagged_c + rtsConstants.offset_StgInd_indirectee, selectee ); return this.stingyEval(c, untagged_c, info, ClosureTypes.IND); } default: { - this.memory.i64Store(untagged_c, info); // Undo whiteholing - this.memory.i64Store( + this.memory.i32Store(untagged_c, info); // Undo whiteholing + this.memory.i32Store( untagged_c + rtsConstants.offset_StgSelector_selectee, res_c ); @@ -252,7 +252,7 @@ export class GC { evacuateClosure(c) { const tag = Memory.getDynTag(c), untagged_c = Memory.unDynTag(c); - const info = Number(this.memory.i64Load(untagged_c)); + const info = (this.memory.i32Load(untagged_c)); if (info % 2) { // The info header has already been overwritten with @@ -296,19 +296,19 @@ export class GC { ); if (type == ClosureTypes.THUNK_SELECTOR || type == ClosureTypes.IND) { // Optimize selectors and indirections - type = this.stingyEval(Number(c), untagged_c, info, type)[1]; + type = this.stingyEval((c), untagged_c, info, type)[1]; } switch (type) { case ClosureTypes.CONSTR_0_1: case ClosureTypes.FUN_0_1: case ClosureTypes.FUN_1_0: case ClosureTypes.CONSTR_1_0: { - dest_c = this.copyClosure(untagged_c, 16); + dest_c = this.copyClosure(untagged_c, 8); break; } case ClosureTypes.THUNK_1_0: case ClosureTypes.THUNK_0_1: { - dest_c = this.copyClosure(untagged_c, rtsConstants.sizeof_StgThunk + 8); + dest_c = this.copyClosure(untagged_c, rtsConstants.sizeof_StgThunk + 4); break; } case ClosureTypes.THUNK_1_1: @@ -316,7 +316,7 @@ export class GC { case ClosureTypes.THUNK_0_2: { dest_c = this.copyClosure( untagged_c, - rtsConstants.sizeof_StgThunk + 16 + rtsConstants.sizeof_StgThunk + 8 ); break; } @@ -338,7 +338,7 @@ export class GC { ); dest_c = this.copyClosure( untagged_c, - rtsConstants.sizeof_StgThunk + ((ptrs + non_ptrs) << 3) + rtsConstants.sizeof_StgThunk + ((ptrs + non_ptrs) << 2) ); break; } @@ -359,7 +359,7 @@ export class GC { non_ptrs = this.memory.i32Load( info + rtsConstants.offset_StgInfoTable_layout + 4 ); - dest_c = this.copyClosure(untagged_c, (1 + ptrs + non_ptrs) << 3); + dest_c = this.copyClosure(untagged_c, (1 + ptrs + non_ptrs) << 2); if (info === this.symbolTable.addressOf("stg_JSVAL_info")) { this.liveJSValManager.closure2Val.set( @@ -376,13 +376,13 @@ export class GC { } case ClosureTypes.IND: { dest_c = this.evacuateClosure( - this.memory.i64Load( + this.memory.i32Load( untagged_c + rtsConstants.offset_StgInd_indirectee ) ); // cannot simply break here, because in the case of IND closures // dest_c must not be tagged with the current tag - this.memory.i64Store(untagged_c, Memory.setDynTag(dest_c, 1)); + this.memory.i32Store(untagged_c, Memory.setDynTag(dest_c, 1)); return dest_c; } case ClosureTypes.PAP: { @@ -391,7 +391,7 @@ export class GC { ); dest_c = this.copyClosure( untagged_c, - rtsConstants.sizeof_StgPAP + (n_args << 3) + rtsConstants.sizeof_StgPAP + (n_args << 2) ); break; } @@ -401,17 +401,17 @@ export class GC { ); dest_c = this.copyClosure( untagged_c, - rtsConstants.sizeof_StgAP + (n_args << 3) + rtsConstants.sizeof_StgAP + (n_args << 2) ); break; } case ClosureTypes.AP_STACK: { - const size = Number( - this.memory.i64Load(untagged_c + rtsConstants.offset_StgAP_STACK_size) + const size = ( + this.memory.i32Load(untagged_c + rtsConstants.offset_StgAP_STACK_size) ); dest_c = this.copyClosure( untagged_c, - rtsConstants.sizeof_StgAP_STACK + (size << 3) + rtsConstants.sizeof_StgAP_STACK + (size << 2) ); break; } @@ -420,13 +420,13 @@ export class GC { untagged_c, Math.ceil( (rtsConstants.sizeof_StgArrBytes + - Number( - this.memory.i64Load( + ( + this.memory.i32Load( untagged_c + rtsConstants.offset_StgArrBytes_bytes ) )) / - 8 - ) * 8 + 4 + ) * 4 ); break; } @@ -437,12 +437,12 @@ export class GC { dest_c = this.copyClosure( untagged_c, rtsConstants.sizeof_StgMutArrPtrs + - (Number( - this.memory.i64Load( + (( + this.memory.i32Load( untagged_c + rtsConstants.offset_StgMutArrPtrs_ptrs ) ) << - 3) + 2) ); break; } @@ -453,12 +453,12 @@ export class GC { dest_c = this.copyClosure( untagged_c, rtsConstants.sizeof_StgSmallMutArrPtrs + - (Number( - this.memory.i64Load( + (( + this.memory.i32Load( untagged_c + rtsConstants.offset_StgSmallMutArrPtrs_ptrs ) ) << - 3) + 2) ); break; } @@ -468,40 +468,40 @@ export class GC { // Overwrite the object header with a forwarding // pointer (i.e. store the address with the // least significant bit set to 1) - this.memory.i64Store(untagged_c, dest_c + 1); + this.memory.i32Store(untagged_c, dest_c + 1); // Finally, return the new address return Memory.setDynTag(dest_c, tag); } scavengeClosureAt(p) { - this.memory.i64Store(p, this.evacuateClosure(this.memory.i64Load(p))); + this.memory.i32Store(p, this.evacuateClosure(this.memory.i32Load(p))); } scavengePointersFirst(payload, ptrs) { - for (let i = 0; i < ptrs; ++i) this.scavengeClosureAt(payload + (i << 3)); + for (let i = 0; i < ptrs; ++i) this.scavengeClosureAt(payload + (i << 2)); } scavengeSmallBitmap(payload, bitmap, size) { for (let i = 0; i < size; ++i) - if (!(Number(bitmap >> BigInt(i)) & 1)) - this.scavengeClosureAt(payload + (i << 3)); + if (!((bitmap >> (i)) & 1)) + this.scavengeClosureAt(payload + (i << 2)); } scavengeLargeBitmap(payload, large_bitmap, size) { - for (let j = 0; j < size; j += 64) { - const bitmap = this.memory.i64Load( - large_bitmap + rtsConstants.offset_StgLargeBitmap_bitmap + (j >> 3) + for (let j = 0; j < size; j += 32) { + const bitmap = this.memory.i32Load( + large_bitmap + rtsConstants.offset_StgLargeBitmap_bitmap + (j >> 2) ); - for (let i = j; i - j < 64 && i < size; ++i) - if (!(Number(bitmap >> BigInt(i - j)) & 1)) - this.scavengeClosureAt(payload + (i << 3)); + for (let i = j; i - j < 32 && i < size; ++i) + if (!((bitmap >> (i - j)) & 1)) + this.scavengeClosureAt(payload + (i << 2)); } } scavengePAP(c, offset_fun, payload, n_args) { this.scavengeClosureAt(c + offset_fun); - const fun = this.memory.i64Load(c + offset_fun), - fun_info = Number(this.memory.i64Load(Memory.unDynTag(fun))); + const fun = this.memory.i32Load(c + offset_fun), + fun_info = (this.memory.i32Load(Memory.unDynTag(fun))); if (this.infoTables && !this.infoTables.has(fun_info)) throw new WebAssembly.RuntimeError( `Invalid info table 0x${fun_info.toString(16)}` @@ -516,11 +516,11 @@ export class GC { case FunTypes.ARG_GEN: { this.scavengeSmallBitmap( payload, - this.memory.i64Load( + this.memory.i32Load( fun_info + rtsConstants.offset_StgFunInfoTable_f + rtsConstants.offset_StgFunInfoExtraFwd_b - ) >> BigInt(6), + ) >> (5), n_args ); break; @@ -528,8 +528,8 @@ export class GC { case FunTypes.ARG_GEN_BIG: { this.scavengeLargeBitmap( payload, - Number( - this.memory.i64Load( + ( + this.memory.i32Load( fun_info + rtsConstants.offset_StgFunInfoTable_f + rtsConstants.offset_StgFunInfoExtraFwd_b @@ -545,7 +545,7 @@ export class GC { default: { this.scavengeSmallBitmap( payload, - BigInt( + ( stg_arg_bitmaps[ this.memory.i32Load( fun_info + @@ -553,7 +553,7 @@ export class GC { rtsConstants.offset_StgFunInfoExtraFwd_fun_type ) ] - ) >> BigInt(6), + ) >> (5), n_args ); break; @@ -566,11 +566,11 @@ export class GC { while (true) { if (c > sp_lim) throw new WebAssembly.RuntimeError(); if (c == sp_lim) break; - const info = Number(this.memory.i64Load(c)), + const info = (this.memory.i32Load(c)), type = this.memory.i32Load( info + rtsConstants.offset_StgInfoTable_type ), - raw_layout = this.memory.i64Load( + raw_layout = this.memory.i32Load( info + rtsConstants.offset_StgInfoTable_layout ); if (this.infoTables && !this.infoTables.has(info)) @@ -579,7 +579,7 @@ export class GC { ); if (this.memory.i32Load(info + rtsConstants.offset_StgInfoTable_srt)) this.evacuateClosure( - this.memory.i64Load(info + rtsConstants.offset_StgRetInfoTable_srt) + this.memory.i32Load(info + rtsConstants.offset_StgRetInfoTable_srt) ); switch (type) { case ClosureTypes.RET_SMALL: @@ -590,20 +590,20 @@ export class GC { case ClosureTypes.ATOMICALLY_FRAME: case ClosureTypes.CATCH_RETRY_FRAME: case ClosureTypes.CATCH_STM_FRAME: { - const size = Number(raw_layout) & 0x3f, - bitmap = raw_layout >> BigInt(6); - this.scavengeSmallBitmap(c + 8, bitmap, size); - c += (1 + size) << 3; + const size = raw_layout & 0x1f, + bitmap = raw_layout >> (5); + this.scavengeSmallBitmap(c + 4, bitmap, size); + c += (1 + size) << 2; break; } case ClosureTypes.RET_BIG: { - const size = Number( - this.memory.i64Load( - Number(raw_layout) + rtsConstants.offset_StgLargeBitmap_size + const size = ( + this.memory.i32Load( + raw_layout + rtsConstants.offset_StgLargeBitmap_size ) ); - this.scavengeLargeBitmap(c + 8, Number(raw_layout), size); - c += (1 + size) << 3; + this.scavengeLargeBitmap(c + 4, raw_layout, size); + c += (1 + size) << 2; break; } @@ -611,20 +611,20 @@ export class GC { // https://github.com/ghc/ghc/blob/2ff77b9894eecf51fa619ed2266ca196e296cd1e/rts/sm/Scav.c#L1944 case ClosureTypes.RET_FUN: { const retfun = c; - const size = Number( - this.memory.i64Load(retfun + rtsConstants.offset_StgRetFun_size) + const size = ( + this.memory.i32Load(retfun + rtsConstants.offset_StgRetFun_size) ); // NOTE: the order is important. The scavenging will move all the // data inside, so that when we grab "fun", we grab the right fun // that has been moved. this.scavengeClosureAt(retfun + rtsConstants.offset_StgRetFun_fun); - let fun = Number( - this.memory.i64Load(retfun + rtsConstants.offset_StgRetFun_fun) + let fun = ( + this.memory.i32Load(retfun + rtsConstants.offset_StgRetFun_fun) ); const fun_info_p = fun + 0; - const fun_info = Number( - this.memory.i64Load(Memory.unDynTag(fun_info_p)) + const fun_info = ( + this.memory.i32Load(Memory.unDynTag(fun_info_p)) ); const fun_type = this.memory.i32Load( @@ -640,11 +640,11 @@ export class GC { case FunTypes.ARG_GEN: { this.scavengeSmallBitmap( c + rtsConstants.offset_StgRetFun_payload, - this.memory.i64Load( + this.memory.i32Load( fun_info + rtsConstants.offset_StgFunInfoTable_f + rtsConstants.offset_StgFunInfoExtraFwd_b - ) >> BigInt(6), + ) >> 5, size ); break; @@ -652,8 +652,8 @@ export class GC { case FunTypes.ARG_GEN_BIG: { this.scavengeLargeBitmap( c + rtsConstants.offset_StgRetFun_payload, - Number( - this.memory.i64Load( + ( + this.memory.i32Load( fun_info + rtsConstants.offset_StgFunInfoTable_f + rtsConstants.offset_StgFunInfoExtraFwd_b @@ -668,12 +668,12 @@ export class GC { } default: { // https://github.com/ghc/ghc/blob/bf73419518ca550e85188616f860961c7e2a336b/includes/rts/Constants.h#L186 - const BITMAP_SIZE_MASK = 0x3f; - const BITMAP_BITS_SHIFT = 6; + const BITMAP_SIZE_MASK = 0x1f; + const BITMAP_BITS_SHIFT = 5; const bitmap = stg_arg_bitmaps[fun_type]; // https://github.com/ghc/ghc/blob/2ff77b9894eecf51fa619ed2266ca196e296cd1e/includes/rts/storage/InfoTables.h#L116 - const bitmap_bits = BigInt(bitmap) >> BigInt(BITMAP_BITS_SHIFT); + const bitmap_bits = (bitmap) >> (BITMAP_BITS_SHIFT); const bitmap_size = bitmap & BITMAP_SIZE_MASK; this.scavengeSmallBitmap( @@ -685,7 +685,7 @@ export class GC { break; } // end case default } //end switch (fun_type) - c += rtsConstants.sizeof_StgRetFun + (size << 3); + c += rtsConstants.sizeof_StgRetFun + (size << 2); break; } default: @@ -720,8 +720,8 @@ export class GC { // start with the object pointed // by the `start` field in the block // descriptor - currentObject = Number( - this.memory.i64Load( + currentObject = ( + this.memory.i32Load( currentBlock + rtsConstants.offset_bdescr_start ) ); @@ -732,8 +732,8 @@ export class GC { // `currentLimit` is the upper limit for `currentBlock` // and consists of a pointer to the free space in the // current block - const currentLimit = Number( - this.memory.i64Load( + const currentLimit = ( + this.memory.i32Load( currentBlock + rtsConstants.offset_bdescr_free ) ); @@ -777,7 +777,7 @@ export class GC { * @returns The size (in bytes) of the closure c */ scavengeClosure(c) { - const info = Number(this.memory.i64Load(c)), + const info = (this.memory.i32Load(c)), type = this.memory.i32Load(info + rtsConstants.offset_StgInfoTable_type); if (this.infoTables && !this.infoTables.has(info)) throw new WebAssembly.RuntimeError( @@ -785,22 +785,22 @@ export class GC { ); switch (type) { case ClosureTypes.CONSTR_1_0: { - this.scavengePointersFirst(c + 8, 1); - return 16; + this.scavengePointersFirst(c + 4, 1); + return 8; } case ClosureTypes.CONSTR_0_1: { - return 16; + return 8; } case ClosureTypes.CONSTR_1_1: { - this.scavengePointersFirst(c + 8, 1); - return 24; + this.scavengePointersFirst(c + 4, 1); + return 12; } case ClosureTypes.CONSTR_2_0: { - this.scavengePointersFirst(c + 8, 2); - return 24; + this.scavengePointersFirst(c + 4, 2); + return 12; } case ClosureTypes.CONSTR_0_2: { - return 24; + return 12; } case ClosureTypes.FUN: case ClosureTypes.FUN_1_0: @@ -811,7 +811,7 @@ export class GC { case ClosureTypes.FUN_STATIC: { if (this.memory.i32Load(info + rtsConstants.offset_StgInfoTable_srt)) this.evacuateClosure( - this.memory.i64Load( + this.memory.i32Load( info + rtsConstants.offset_StgFunInfoTable_f + rtsConstants.offset_StgFunInfoExtraFwd_srt @@ -823,8 +823,8 @@ export class GC { non_ptrs = this.memory.i32Load( info + rtsConstants.offset_StgInfoTable_layout + 4 ); - this.scavengePointersFirst(c + 8, ptrs); - return (1 + ptrs + non_ptrs) << 3; + this.scavengePointersFirst(c + 4, ptrs); + return (1 + ptrs + non_ptrs) << 2; } case ClosureTypes.CONSTR: case ClosureTypes.CONSTR_NOCAF: @@ -840,8 +840,8 @@ export class GC { non_ptrs = this.memory.i32Load( info + rtsConstants.offset_StgInfoTable_layout + 4 ); - this.scavengePointersFirst(c + 8, ptrs); - return (1 + ptrs + non_ptrs) << 3; + this.scavengePointersFirst(c + 4, ptrs); + return (1 + ptrs + non_ptrs) << 2; } case ClosureTypes.THUNK_STATIC: case ClosureTypes.THUNK: @@ -852,7 +852,7 @@ export class GC { case ClosureTypes.THUNK_0_2: { if (this.memory.i32Load(info + rtsConstants.offset_StgInfoTable_srt)) this.evacuateClosure( - this.memory.i64Load( + this.memory.i32Load( info + rtsConstants.offset_StgThunkInfoTable_srt ) ); @@ -866,12 +866,12 @@ export class GC { c + rtsConstants.offset_StgThunk_payload, ptrs ); - return rtsConstants.sizeof_StgThunk + ((ptrs + non_ptrs) << 3); + return rtsConstants.sizeof_StgThunk + ((ptrs + non_ptrs) << 2); } case ClosureTypes.THUNK_SELECTOR: { if (this.memory.i32Load(info + rtsConstants.offset_StgInfoTable_srt)) this.evacuateClosure( - this.memory.i64Load( + this.memory.i32Load( info + rtsConstants.offset_StgThunkInfoTable_srt ) ); @@ -888,7 +888,7 @@ export class GC { c + rtsConstants.offset_StgAP_payload, n_args ); - return rtsConstants.sizeof_StgAP + (n_args << 3); + return rtsConstants.sizeof_StgAP + (n_args << 2); } case ClosureTypes.PAP: { const n_args = this.memory.i32Load( @@ -900,11 +900,11 @@ export class GC { c + rtsConstants.offset_StgPAP_payload, n_args ); - return rtsConstants.sizeof_StgPAP + (n_args << 3); + return rtsConstants.sizeof_StgPAP + (n_args << 2); } case ClosureTypes.AP_STACK: { - const size = Number( - this.memory.i64Load( + const size = ( + this.memory.i32Load( c + rtsConstants.offset_StgAP_STACK_size ) ); @@ -914,7 +914,7 @@ export class GC { c + rtsConstants.offset_StgAP_STACK_payload + size ); - return rtsConstants.sizeof_StgAP_STACK + (size << 3); + return rtsConstants.sizeof_StgAP_STACK + (size << 2); } case ClosureTypes.IND_STATIC: { this.scavengeClosureAt(c + rtsConstants.offset_StgIndStatic_indirectee); @@ -925,38 +925,38 @@ export class GC { this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_head); this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_tail); this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_value); - return rtsConstants.offset_StgMVar_value + 8; + return rtsConstants.offset_StgMVar_value + 4; } case ClosureTypes.ARR_WORDS: { return ( Math.ceil( (rtsConstants.sizeof_StgArrBytes + - Number( - this.memory.i64Load(c + rtsConstants.offset_StgArrBytes_bytes) + ( + this.memory.i32Load(c + rtsConstants.offset_StgArrBytes_bytes) )) / - 8 - ) * 8 + 4 + ) * 4 ); } case ClosureTypes.MUT_ARR_PTRS_CLEAN: case ClosureTypes.MUT_ARR_PTRS_DIRTY: case ClosureTypes.MUT_ARR_PTRS_FROZEN_DIRTY: case ClosureTypes.MUT_ARR_PTRS_FROZEN_CLEAN: { - const ptrs = Number( - this.memory.i64Load(c + rtsConstants.offset_StgMutArrPtrs_ptrs) + const ptrs = ( + this.memory.i32Load(c + rtsConstants.offset_StgMutArrPtrs_ptrs) ); this.scavengePointersFirst( c + rtsConstants.offset_StgMutArrPtrs_payload, ptrs ); - return rtsConstants.sizeof_StgMutArrPtrs + (ptrs << 3); + return rtsConstants.sizeof_StgMutArrPtrs + (ptrs << 2); } case ClosureTypes.WEAK: { this.scavengeClosureAt(c + rtsConstants.offset_StgWeak_cfinalizers); this.scavengeClosureAt(c + rtsConstants.offset_StgWeak_key); this.scavengeClosureAt(c + rtsConstants.offset_StgWeak_value); this.scavengeClosureAt(c + rtsConstants.offset_StgWeak_finalizer); - return rtsConstants.offset_StgWeak_link + 8; + return rtsConstants.offset_StgWeak_link + 4; } case ClosureTypes.TSO: { this.scavengeClosureAt(c + rtsConstants.offset_StgTSO_stackobj); @@ -965,8 +965,8 @@ export class GC { case ClosureTypes.STACK: { const stack_size = - this.memory.i32Load(c + rtsConstants.offset_StgStack_stack_size) << 3, - sp = Number(this.memory.i64Load(c + rtsConstants.offset_StgStack_sp)), + this.memory.i32Load(c + rtsConstants.offset_StgStack_stack_size) << 2, + sp = (this.memory.i32Load(c + rtsConstants.offset_StgStack_sp)), sp_lim = c + rtsConstants.offset_StgStack_stack + stack_size; this.scavengeStackChunk(sp, sp_lim); return rtsConstants.offset_StgStack_stack + stack_size; @@ -975,14 +975,14 @@ export class GC { case ClosureTypes.SMALL_MUT_ARR_PTRS_DIRTY: case ClosureTypes.SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: case ClosureTypes.SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: { - const ptrs = Number( - this.memory.i64Load(c + rtsConstants.offset_StgSmallMutArrPtrs_ptrs) + const ptrs = ( + this.memory.i32Load(c + rtsConstants.offset_StgSmallMutArrPtrs_ptrs) ); this.scavengePointersFirst( c + rtsConstants.offset_StgSmallMutArrPtrs_payload, ptrs ); - return rtsConstants.offset_StgSmallMutArrPtrs_payload + (ptrs << 3); + return rtsConstants.offset_StgSmallMutArrPtrs_payload + (ptrs << 2); } default: throw new WebAssembly.RuntimeError(); @@ -1001,17 +1001,17 @@ export class GC { // use it to determine the size of the newly allocated nursery. const base_reg = this.symbolTable.addressOf("MainCapability") + rtsConstants.offset_Capability_r, - hp_alloc = Number( - this.memory.i64Load(base_reg + rtsConstants.offset_StgRegTable_rHpAlloc) + hp_alloc = ( + this.memory.i32Load(base_reg + rtsConstants.offset_StgRegTable_rHpAlloc) ); // reset the number of allocated bytes in the nursery - this.memory.i64Store( + this.memory.i32Store( base_reg + rtsConstants.offset_StgRegTable_rHpAlloc, 0 ); // The address of the new nursery's block descriptor is stored // in the 'rCurrentNursery' field of the StgRegTable of the main capability. - this.memory.i64Store( + this.memory.i32Store( base_reg + rtsConstants.offset_StgRegTable_rCurrentNursery, this.heapAlloc.hpAlloc(hp_alloc) ); @@ -1068,13 +1068,13 @@ export class GC { for (const [_, tso_info] of this.scheduler.tsos) { if (tso_info.ret) { const tso = tso_info.addr; - const stackobj = Number( - this.memory.i64Load(tso + rtsConstants.offset_StgTSO_stackobj) + const stackobj = ( + this.memory.i32Load(tso + rtsConstants.offset_StgTSO_stackobj) ); - const sp = Number( - this.memory.i64Load(stackobj + rtsConstants.offset_StgStack_sp) + const sp = ( + this.memory.i32Load(stackobj + rtsConstants.offset_StgStack_sp) ); - tso_info.ret = Number(this.memory.i64Load(sp + 8)); + tso_info.ret = (this.memory.i32Load(sp + 4)); } } diff --git a/asterius/rts/rts.heapalloc.mjs b/asterius/rts/rts.heapalloc.mjs index 3bf9acc9..29445ccd 100644 --- a/asterius/rts/rts.heapalloc.mjs +++ b/asterius/rts/rts.heapalloc.mjs @@ -1,4 +1,5 @@ import * as rtsConstants from "./rts.constants.mjs"; +import { isI32 } from "./rts.typecheck.mjs"; /** * Class implementing the allocation of nurseries, @@ -73,6 +74,7 @@ export class HeapAlloc { * of the first MBlock of the MegaGroup. */ hpAlloc(b, pinned=false, gen_no=0) { + isI32(b); const mblocks = b <= rtsConstants.sizeof_first_mblock ? 1 @@ -81,7 +83,7 @@ export class HeapAlloc { (b - rtsConstants.sizeof_first_mblock) / rtsConstants.mblock_size ), bd = this.allocMegaGroup(mblocks, pinned, gen_no); - return bd; + return isI32(bd); } /** @@ -91,16 +93,17 @@ export class HeapAlloc { * @param pinned Whether to allocate in the pinned pool */ allocate(n, pinned = false) { - const b = n << 3; // The size in bytes + isI32(n); + const b = n << 2; // The size in bytes // Large objects are forced to be pinned as well // (by large, we mean >= 4KiB): pinned = pinned || b >= rtsConstants.block_size; let pool = this.currentPools[Number(pinned)], - current_start = Number( - this.components.memory.i64Load(pool + rtsConstants.offset_bdescr_start) + current_start = ( + this.components.memory.i32Load(pool + rtsConstants.offset_bdescr_start) ), - current_free = Number( - this.components.memory.i64Load(pool + rtsConstants.offset_bdescr_free) + current_free = ( + this.components.memory.i32Load(pool + rtsConstants.offset_bdescr_free) ); const current_blocks = this.components.memory.i32Load( pool + rtsConstants.offset_bdescr_blocks @@ -110,7 +113,7 @@ export class HeapAlloc { if (new_free <= current_limit) { // if the pool has enough space - this.components.memory.i64Store( + this.components.memory.i32Store( pool + rtsConstants.offset_bdescr_free, new_free ); @@ -126,17 +129,17 @@ export class HeapAlloc { this.currentPools[0] = pool; this.generations[gen_no] = pool; } - current_free = Number( - this.components.memory.i64Load( + current_free = ( + this.components.memory.i32Load( pool + rtsConstants.offset_bdescr_free ) ); - this.components.memory.i64Store( + this.components.memory.i32Store( pool + rtsConstants.offset_bdescr_free, current_free + b ); } - return current_free; + return isI32(current_free); } /** @@ -162,9 +165,9 @@ export class HeapAlloc { mblock = this.components.exports.aligned_alloc(rtsConstants.mblock_size, rtsConstants.mblock_size * n), bd = mblock + rtsConstants.offset_first_bdescr, block_addr = mblock + rtsConstants.offset_first_block; - this.components.memory.i64Store(bd + rtsConstants.offset_bdescr_start, block_addr); - this.components.memory.i64Store(bd + rtsConstants.offset_bdescr_free, block_addr); - this.components.memory.i64Store(bd + rtsConstants.offset_bdescr_link, 0); + this.components.memory.i32Store(bd + rtsConstants.offset_bdescr_start, block_addr); + this.components.memory.i32Store(bd + rtsConstants.offset_bdescr_free, block_addr); + this.components.memory.i32Store(bd + rtsConstants.offset_bdescr_link, 0); this.components.memory.i16Store(bd + rtsConstants.offset_bdescr_node, n); this.components.memory.i32Store(bd + rtsConstants.offset_bdescr_blocks, req_blocks); this.components.memory.i16Store( diff --git a/asterius/rts/rts.jsval.mjs b/asterius/rts/rts.jsval.mjs index a29aa14c..0c772a95 100644 --- a/asterius/rts/rts.jsval.mjs +++ b/asterius/rts/rts.jsval.mjs @@ -7,7 +7,7 @@ export class JSValManager { newJSValzh(v) { const c = this.components.heapAlloc.allocate(1); - this.components.memory.i64Store( + this.components.memory.i32Store( c, this.components.symbolTable.addressOf("stg_JSVAL_info") ); diff --git a/asterius/rts/rts.memory.mjs b/asterius/rts/rts.memory.mjs index 2b6ac99b..d2de5b15 100644 --- a/asterius/rts/rts.memory.mjs +++ b/asterius/rts/rts.memory.mjs @@ -1,3 +1,5 @@ +import { isI32 } from "./rts.typecheck.mjs"; + /** * Class acting as the low-level interface to Wasm memory. * It mainly provides methods to load/store data in memory @@ -39,17 +41,17 @@ export class Memory { } static unDynTag(p) { - const np = Number(p); - return np - (np & 7); + const np = (p); + return np - (np & 2); } static getDynTag(p) { - return Number(p) & 7; + return (p) & 2; } static setDynTag(p, t) { - const np = Number(p); - return np - (np & 7) + t; + const np = (p); + return np - (np & 2) + t; } i8Load(p) { @@ -57,7 +59,7 @@ export class Memory { } i8Store(p, v) { - this.i8View[p] = Number(v); + this.i8View[p] = (v); } i16Load(p) { @@ -65,7 +67,7 @@ export class Memory { } i16Store(p, v) { - this.dataView.setUint16(p, Number(v), true); + this.dataView.setUint16(p, (v), true); } i32Load(p) { @@ -73,7 +75,7 @@ export class Memory { } i32Store(p, v) { - this.dataView.setUint32(p, Number(v), true); + this.dataView.setUint32(p, (v), true); } i64Load(p) { @@ -89,7 +91,7 @@ export class Memory { } f32Store(p, v) { - this.dataView.setFloat32(p, Number(v), true); + this.dataView.setFloat32(p, (v), true); } f64Load(p) { @@ -97,7 +99,7 @@ export class Memory { } f64Store(p, v) { - this.dataView.setFloat64(p, Number(v), true); + this.dataView.setFloat64(p, (v), true); } i32LoadS8(p) { @@ -137,7 +139,8 @@ export class Memory { } strlen(_str) { - return this.components.exports.strlen(_str); + isI32(_str); + return isI32(this.components.exports.strlen(_str)); } strLoad(_str) { @@ -156,7 +159,10 @@ export class Memory { } memchr(_ptr, val, num) { - return this.components.exports.memchr(_ptr, val, num); + isI32(_ptr); + isI32(val); + isI32(num); + return isI32(this.components.exports.memchr(_ptr, val, num)); } memcpy(_dst, _src, n) { diff --git a/asterius/rts/rts.memorytrap.mjs b/asterius/rts/rts.memorytrap.mjs index e9c1efa4..444a436b 100644 --- a/asterius/rts/rts.memorytrap.mjs +++ b/asterius/rts/rts.memorytrap.mjs @@ -20,121 +20,121 @@ export class MemoryTrap { } loadI8(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i8Load(p); } loadI16(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i16Load(p); } loadI32(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i32Load(p); } loadI64(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i64Load(p); } loadI32S8(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i32LoadS8(p); } loadI32U8(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i32LoadU8(p); } loadI32S16(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i32LoadS16(p); } loadI32U16(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i32LoadU16(p); } loadI64S8(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i64LoadS8(p); } loadI64U8(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i64LoadU8(p); } loadI64S16(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i64LoadS16(p); } loadI64U16(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.i64LoadU16(p); } loadF32(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.f32Load(p); } loadF64(sym, bp, o) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); return this.memory.f64Load(p); } storeI8(sym, bp, o, v) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); this.memory.i8Store(p, v); } storeI16(sym, bp, o, v) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); this.memory.i16Store(p, v); } storeI32(sym, bp, o, v) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); this.memory.i32Store(p, v); } storeI64(sym, bp, o, v) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); this.memory.i64Store(p, v); } storeF32(sym, bp, o, v) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); this.memory.f32Store(p, v); } storeF64(sym, bp, o, v) { - const p = Number(bp + BigInt(o)); + const p = (bp + o); this.trap(sym, p); this.memory.f64Store(p, v); } diff --git a/asterius/rts/rts.scheduler.mjs b/asterius/rts/rts.scheduler.mjs index ecb653a9..e9847aa3 100644 --- a/asterius/rts/rts.scheduler.mjs +++ b/asterius/rts/rts.scheduler.mjs @@ -1,4 +1,5 @@ import * as rtsConstants from "./rts.constants.mjs"; +import { isI32 } from "./rts.typecheck.mjs"; /** * Scheduler. @@ -99,8 +100,8 @@ export class Scheduler { returnedFromTSO(tid) { const tso_info = this.tsos.get(tid); const tso = tso_info.addr; - const reason = Number( - this.memory.i64Load( + const reason = ( + this.memory.i32Load( this.symbolTable.addressOf("MainCapability") + rtsConstants.offset_Capability_r + rtsConstants.offset_StgRegTable_rRet @@ -120,11 +121,11 @@ export class Scheduler { } case 2: { // StackOverflow - const prev_stack = Number( - this.memory.i64Load(tso + rtsConstants.offset_StgTSO_stackobj) + const prev_stack = ( + this.memory.i32Load(tso + rtsConstants.offset_StgTSO_stackobj) ), next_stack = this.exports.growStack(prev_stack); - this.memory.i64Store( + this.memory.i32Store( tso + rtsConstants.offset_StgTSO_stackobj, next_stack ); @@ -140,7 +141,7 @@ export class Scheduler { case 4: { // ThreadBlocked - const why_blocked = Number( + const why_blocked = ( this.memory.i16Load(tso + rtsConstants.offset_StgTSO_why_blocked) ); @@ -169,8 +170,8 @@ export class Scheduler { } case Blocked.OnDelay: { - const us_delay = Number( - this.memory.i64Load(tso + rtsConstants.offset_StgTSO_block_info) + const us_delay = ( + this.memory.i32Load(tso + rtsConstants.offset_StgTSO_block_info) ); const blocking_promise = new Promise((resolve, reject) => { setTimeout(() => resolve(), us_delay / 1000); @@ -208,7 +209,7 @@ export class Scheduler { case 5: { // ThreadFinished //console.log(`Thread ${tid}: Finished`); - const what_next = Number( + const what_next = ( this.memory.i16Load(tso + rtsConstants.offset_StgTSO_what_next) ); switch (what_next) { @@ -226,13 +227,13 @@ export class Scheduler { } case 4: { // ThreadComplete - const stackobj = Number( - this.memory.i64Load(tso + rtsConstants.offset_StgTSO_stackobj) + const stackobj = ( + this.memory.i32Load(tso + rtsConstants.offset_StgTSO_stackobj) ); - const sp = Number( - this.memory.i64Load(stackobj + rtsConstants.offset_StgStack_sp) + const sp = ( + this.memory.i32Load(stackobj + rtsConstants.offset_StgStack_sp) ); - tso_info.ret = Number(this.memory.i64Load(sp + 8)); + tso_info.ret = (this.memory.i32Load(sp + 4)); tso_info.rstat = 1; // Success (SchedulerStatus) tso_info.promise_resolve(tid); // rts_eval* functions assume a TID is returned break; @@ -260,13 +261,13 @@ export class Scheduler { if (tso_info.ffiRetErr) { //console.log(`Thread ${tid}: FFI error`); - const stackobj = Number( - this.memory.i64Load(tso + rtsConstants.offset_StgTSO_stackobj) + const stackobj = ( + this.memory.i32Load(tso + rtsConstants.offset_StgTSO_stackobj) ), sp = - Number( - this.memory.i64Load(stackobj + rtsConstants.offset_StgStack_sp) - ) - 16, + ( + this.memory.i32Load(stackobj + rtsConstants.offset_StgStack_sp) + ) - 4, exception_closure = this.exports.rts_apply( this.symbolTable.addressOf( "base_AsteriusziTypesziJSException_mkJSException_closure" @@ -275,9 +276,9 @@ export class Scheduler { this.components.jsvalManager.newJSValzh(tso_info.ffiRetErr) ) ); - this.memory.i64Store(stackobj + rtsConstants.offset_StgStack_sp, sp); - this.memory.i64Store(sp, this.symbolTable.addressOf("stg_raise_ret_info")); - this.memory.i64Store(sp + 8, exception_closure); + this.memory.i32Store(stackobj + rtsConstants.offset_StgStack_sp, sp); + this.memory.i32Store(sp, this.symbolTable.addressOf("stg_raise_ret_info")); + this.memory.i32Store(sp + 4, exception_closure); } else if (typeof tso_info.ffiRetType === "number") { switch ( tso_info.ffiRetType // tag is encoded with `ffiValueTypesTag` @@ -290,7 +291,7 @@ export class Scheduler { // JSVal const ptr = this.components.jsvalManager.newJSValzh(tso_info.ffiRet); //console.log(`Restore after FFI with value: ${tso_info.ffiRet} with type ${typeof tso_info.ffiRet} constructor ${tso_info.ffiRet.constructor} as ${ptr}`); - this.memory.i64Store( + this.memory.i32Store( this.symbolTable.addressOf("MainCapability") + rtsConstants.offset_Capability_r + rtsConstants.offset_StgRegTable_rR1, @@ -299,8 +300,8 @@ export class Scheduler { break; } case 2: { - // I64 - this.memory.i64Store( + // I32 + this.memory.i32Store( this.symbolTable.addressOf("MainCapability") + rtsConstants.offset_Capability_r + rtsConstants.offset_StgRegTable_rR1, @@ -370,12 +371,13 @@ export class Scheduler { * Enqueue the TSO in the run-queue and wake-up the scheduler. */ enqueueTSO(tso) { + isI32(tso); const tid = this.getTSOid(tso); // When the TSO has just been created, we need to store its address const tso_info = this.tsos.get(tid); if (tso_info.addr == -1) { - tso_info.addr = Number(tso); + tso_info.addr = (tso); } // Ensure that we wake up the scheduler at least once to execute this thread diff --git a/asterius/rts/rts.stablename.mjs b/asterius/rts/rts.stablename.mjs index eaa22990..43b044ea 100644 --- a/asterius/rts/rts.stablename.mjs +++ b/asterius/rts/rts.stablename.mjs @@ -1,4 +1,5 @@ import * as rtsConstants from "./rts.constants.mjs"; +import { isI32 } from "./rts.typecheck.mjs"; // https://github.com/ghc/ghc/blob/bf73419518ca550e85188616f860961c7e2a336b/includes/rts/StableName.h // https://github.com/ghc/ghc/blob/43967c0c7d2d0110cfc5f9d64a7dab3a3dda8953/rts/StableName.c @@ -12,6 +13,7 @@ export class StableNameManager { } makeStableName(ptr) { + isI32(ptr); const oldstable = this.ptr2stable.get(ptr); if (oldstable !== undefined) return oldstable; @@ -19,13 +21,13 @@ export class StableNameManager { // https://github.com/ghc/ghc/blob/fe819dd637842fb564524a7cf80612a3673ce14c/includes/rts/storage/Closures.h#L197 let stableptr = this.heapalloc.allocate( - Math.ceil(rtsConstants.sizeof_StgStableName / 8) + Math.ceil(rtsConstants.sizeof_StgStableName / 4) ); - this.memory.i64Store(stableptr, this.SymbolTable.addressOf("stg_STABLE_NAME_info")); - this.memory.i64Store(stableptr + rtsConstants.offset_StgStableName_sn, tag); + this.memory.i32Store(stableptr, this.SymbolTable.addressOf("stg_STABLE_NAME_info")); + this.memory.i32Store(stableptr + rtsConstants.offset_StgStableName_sn, tag); this.ptr2stable.set(ptr, stableptr); - return stableptr; + return isI32(stableptr); } } diff --git a/asterius/rts/rts.stableptr.mjs b/asterius/rts/rts.stableptr.mjs index 11ced003..6e29d9b9 100644 --- a/asterius/rts/rts.stableptr.mjs +++ b/asterius/rts/rts.stableptr.mjs @@ -1,3 +1,5 @@ +import { isI32 } from "./rts.typecheck.mjs"; + export class StablePtrManager { constructor() { this.spt = new Map(); @@ -6,16 +8,19 @@ export class StablePtrManager { } newStablePtr(addr) { + isI32(addr); const sp = ++this.last; this.spt.set(sp, addr); - return sp; + return isI32(sp); } deRefStablePtr(sp) { - return this.spt.get(sp); + isI32(sp); + return isI32(this.spt.get(sp)); } freeStablePtr(sp) { + isI32(sp); this.spt.delete(sp); } diff --git a/asterius/rts/rts.typecheck.mjs b/asterius/rts/rts.typecheck.mjs new file mode 100644 index 00000000..991010e5 --- /dev/null +++ b/asterius/rts/rts.typecheck.mjs @@ -0,0 +1,9 @@ +export function isI32(v) { + if (!Number.isSafeInteger(v)) { + throw WebAssembly.RuntimeError(`${v} not a safe integer`); + } + if (v < 0 || v > 0xffffffff) { + throw WebAssembly.RuntimeError(`${v} range error`); + } + return v; +} diff --git a/asterius/src-types/Asterius/Types.hs b/asterius/src-types/Asterius/Types.hs index ca0590e2..4afa1334 100644 --- a/asterius/src-types/Asterius/Types.hs +++ b/asterius/src-types/Asterius/Types.hs @@ -92,6 +92,7 @@ data AsteriusCodeGenError | UnsupportedCmmSectionType BS.ByteString | UnsupportedImplicitCasting Expression ValueType ValueType | AssignToImmutableGlobalReg UnresolvedGlobalReg + | UnsupportedTodo String deriving (Show, Data) instance Exception AsteriusCodeGenError @@ -271,6 +272,11 @@ data UnaryOp | DemoteFloat64 | ReinterpretInt32 | ReinterpretInt64 + | ExtendS8Int32 + | ExtendS16Int32 + | ExtendS8Int64 + | ExtendS16Int64 + | ExtendS32Int64 deriving (Show, Data) data BinaryOp @@ -460,10 +466,10 @@ data Expression { dropValue :: Expression } | ReturnCall - { returnCallTarget64 :: EntitySymbol + { returnCallTarget :: EntitySymbol } | ReturnCallIndirect - { returnCallIndirectTarget64 :: Expression + { returnCallIndirectTarget :: Expression } | Nop | Unreachable diff --git a/asterius/src/Asterius/Backends/Binaryen.hs b/asterius/src/Asterius/Backends/Binaryen.hs index 70415e56..689b88fc 100644 --- a/asterius/src/Asterius/Backends/Binaryen.hs +++ b/asterius/src/Asterius/Backends/Binaryen.hs @@ -27,6 +27,7 @@ import Asterius.Internals.Barf import Asterius.Internals.MagicNumber import Asterius.Internals.Marshal import Asterius.Passes.CCall +import Asterius.Passes.Relooper import Asterius.Types import qualified Asterius.Types.SymbolMap as SM import Asterius.TypesConv @@ -64,6 +65,7 @@ import Foreign hiding import Foreign.C import GHC.Exts import Asterius.JSGen.Wizer +import qualified Binaryen.Features as Binaryen newtype MarshalError = UnsupportedExpression Expression @@ -157,6 +159,11 @@ marshalUnaryOp op = case op of DemoteFloat64 -> Binaryen.demoteFloat64 ReinterpretInt32 -> Binaryen.reinterpretInt32 ReinterpretInt64 -> Binaryen.reinterpretInt64 + ExtendS8Int32 -> Binaryen.extendS8Int32 + ExtendS16Int32 -> Binaryen.extendS16Int32 + ExtendS8Int64 -> Binaryen.extendS8Int64 + ExtendS16Int64 -> Binaryen.extendS16Int64 + ExtendS32Int64 -> Binaryen.extendS32Int64 marshalBinaryOp :: BinaryOp -> Binaryen.Op marshalBinaryOp op = case op of @@ -341,7 +348,7 @@ marshalExpression e' = do ( if target == "barf" then [ case operands of - [] -> ConstI64 0 + [] -> ConstI32 0 x : _ -> x ] else operands @@ -445,13 +452,13 @@ marshalExpression e' = do lift $ Binaryen.drop m x ReturnCall {..} -> do fn_off_map <- askFunctionsOffsetMap - case SM.lookup returnCallTarget64 fn_off_map of + case SM.lookup returnCallTarget fn_off_map of Just off -> do s <- marshalExpression SetGlobal { globalSymbol = "__asterius_pc", - value = ConstI64 $ mkStaticFunctionAddress off + value = ConstI32 $ mkStaticFunctionAddress off } m <- askModuleRef a <- askArena @@ -459,13 +466,13 @@ marshalExpression e' = do r <- Binaryen.return m (coerce nullPtr) (arr, _) <- marshalV a [s, r] Binaryen.block m (coerce nullPtr) arr 2 Binaryen.none - Nothing -> marshalExpression $ barf (entityName returnCallTarget64) [] + Nothing -> marshalExpression $ barf (entityName returnCallTarget) [] ReturnCallIndirect {..} -> do s <- marshalExpression SetGlobal { globalSymbol = "__asterius_pc", - value = returnCallIndirectTarget64 + value = returnCallIndirectTarget } m <- askModuleRef a <- askArena @@ -479,7 +486,7 @@ marshalExpression e' = do Unreachable -> do m <- askModuleRef lift $ Binaryen.Expression.unreachable m - CFG {..} -> relooperRun graph + CFG {..} -> marshalExpression $ relooper graph Symbol {..} -> do verbose_err <- isVerboseErrOn ss_off_map <- askStaticsOffsetMap @@ -488,14 +495,14 @@ marshalExpression e' = do m <- askModuleRef if | Just off <- SM.lookup unresolvedSymbol ss_off_map -> marshalExpression $ - ConstI64 $ mkStaticDataAddress memory_base $ off + fromIntegral symbolOffset + ConstI32 $ mkStaticDataAddress memory_base $ off + fromIntegral symbolOffset | Just off <- SM.lookup unresolvedSymbol fn_off_map -> marshalExpression $ - ConstI64 $ mkStaticFunctionAddress $ off + fromIntegral symbolOffset + ConstI32 $ mkStaticFunctionAddress $ off + fromIntegral symbolOffset | verbose_err -> - marshalExpression $ barf (entityName unresolvedSymbol) [I64] + marshalExpression $ barf (entityName unresolvedSymbol) [I32] | otherwise -> - lift $ Binaryen.constInt64 m invalidAddress + lift $ Binaryen.constInt32 m invalidAddress Barf {..} -> do verbose_err <- isVerboseErrOn if verbose_err @@ -656,7 +663,7 @@ marshalModule verbose_err ss_off_map fn_off_map last_data_offset hs_mod@Module { pure (m, memory_base) checkOverlapDataSegment m Binaryen.setFeatures m - $ foldl1' (.|.) [Binaryen.mvp] + $ foldl1' (.|.) [Binaryen.mvp, Binaryen.signExt] A.with $ \a -> do libc_func_names <- binaryenModuleExportNames m for_ libc_func_names $ diff --git a/asterius/src/Asterius/Binary/File.hs b/asterius/src/Asterius/Binary/File.hs index 89895f18..e15bf0cb 100644 --- a/asterius/src/Asterius/Binary/File.hs +++ b/asterius/src/Asterius/Binary/File.hs @@ -16,7 +16,7 @@ import System.FilePath putFile :: GHC.Binary a => FilePath -> a -> IO () putFile p a = do - bh <- GHC.openBinMem 1048576 + bh <- GHC.openBinMem 1073741824 GHC.putWithUserData (const (pure ())) bh a createDirectoryIfMissing True $ takeDirectory p GHC.writeBinMem bh p diff --git a/asterius/src/Asterius/Builtins.hs b/asterius/src/Asterius/Builtins.hs index 183bc0f0..7e253bc5 100644 --- a/asterius/src/Asterius/Builtins.hs +++ b/asterius/src/Asterius/Builtins.hs @@ -69,7 +69,7 @@ rtsAsteriusModule opts = asteriusStatics = [ Serialized $ BS.pack $ replicate - (8 * roundup_bytes_to_words sizeof_Capability) + (4 * roundup_bytes_to_words sizeof_Capability) 0 ] } @@ -77,7 +77,7 @@ rtsAsteriusModule opts = ( "rts_stop_on_exception", AsteriusStatics { staticsType = Bytes, - asteriusStatics = [Serialized $ encodeStorable (0 :: Word64)] + asteriusStatics = [Serialized $ encodeStorable (0 :: Word32)] } ), ( "n_capabilities", @@ -119,10 +119,10 @@ rtsAsteriusModule opts = [ ( "__asterius_pc", Global { globalType = GlobalType - { globalValueType = I64, + { globalValueType = I32, globalMutability = Mutable }, - globalInit = ConstI64 invalidAddress + globalInit = ConstI32 invalidAddress } ) ], @@ -142,12 +142,7 @@ rtsAsteriusModule opts = <> allocatePinnedFunction opts <> newCAFFunction opts <> stgReturnFunction opts - <> printI64Function opts - <> printF32Function opts - <> printF64Function opts - <> assertEqI64Function opts <> strlenFunction opts - <> debugBelch2Function opts <> memchrFunction opts <> threadPausedFunction opts <> dirtyMutVarFunction opts @@ -168,7 +163,6 @@ rtsAsteriusModule opts = <> rtsSupportsBoundThreadsFunction opts <> readFunction opts <> writeFunction opts - <> (if debug opts then generateRtsAsteriusDebugModule opts else mempty) -- Add in the module that contain functions which need to be -- exposed to the outside world. So add in the module, and -- the module wrapped by using `generateWrapperModule`. @@ -176,20 +170,16 @@ rtsAsteriusModule opts = <> generateWrapperModule (generateRtsExternalInterfaceModule opts) <> blackholeCBits <> generateWrapperModule blackholeCBits - <> exportsCBits <> smCBits <> generateWrapperModule smCBits <> sparksCBits - <> schedulerCBits <> cmathCBits <> envCBits <> posixCBits <> sptCBits <> stgPrimFloatCBits - <> timeCBits <> primitiveCBits <> endiannessCBits - <> barfCBits -- Generate the module consisting of functions which need to be wrapped -- for communication with the external runtime. @@ -224,15 +214,6 @@ generateRtsExternalInterfaceModule opts = <> generateRtsGetIntFunction opts "rts_getJSVal" <> loadI64Function opts --- Generate the module consisting of debug functions -generateRtsAsteriusDebugModule :: BuiltinsOptions -> AsteriusModule -generateRtsAsteriusDebugModule opts = - mempty - <> getF64GlobalRegFunction opts "__asterius_Load_Sp" Sp - <> getF64GlobalRegFunction opts "__asterius_Load_SpLim" SpLim - <> getF64GlobalRegFunction opts "__asterius_Load_Hp" Hp - <> getF64GlobalRegFunction opts "__asterius_Load_HpLim" SpLim - rtsFunctionImports :: Bool -> [FunctionImport] rtsFunctionImports debug = [ FunctionImport @@ -240,8 +221,8 @@ rtsFunctionImports debug = externalModuleName = "StablePtr", externalBaseName = "newStablePtr", functionType = FunctionType - { paramTypes = [F64], - returnTypes = [F64] + { paramTypes = [I32], + returnTypes = [I32] } }, FunctionImport @@ -249,48 +230,48 @@ rtsFunctionImports debug = externalModuleName = "StablePtr", externalBaseName = "deRefStablePtr", functionType = FunctionType - { paramTypes = [F64], - returnTypes = [F64] + { paramTypes = [I32], + returnTypes = [I32] } }, FunctionImport { internalName = "__asterius_freeStablePtr", externalModuleName = "StablePtr", externalBaseName = "freeStablePtr", - functionType = FunctionType {paramTypes = [F64], returnTypes = []} + functionType = FunctionType {paramTypes = [I32], returnTypes = []} }, FunctionImport { internalName = "__asterius_makeStableName", externalModuleName = "StableName", externalBaseName = "makeStableName", functionType = FunctionType - { paramTypes = [F64], - returnTypes = [F64] + { paramTypes = [I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "printI64", + { internalName = "print_i64", externalModuleName = "rts", externalBaseName = "printI64", - functionType = FunctionType {paramTypes = [F64], returnTypes = []} + functionType = FunctionType {paramTypes = [I64], returnTypes = []} }, FunctionImport - { internalName = "assertEqI64", + { internalName = "assert_eq_i64", externalModuleName = "rts", externalBaseName = "assertEqI64", functionType = FunctionType - { paramTypes = [F64, F64], + { paramTypes = [I64, I64], returnTypes = [] } }, FunctionImport - { internalName = "printF32", + { internalName = "print_f32", externalModuleName = "rts", externalBaseName = "print", functionType = FunctionType {paramTypes = [F32], returnTypes = []} }, FunctionImport - { internalName = "printF64", + { internalName = "print_f64", externalModuleName = "rts", externalBaseName = "print", functionType = FunctionType {paramTypes = [F64], returnTypes = []} @@ -301,33 +282,6 @@ rtsFunctionImports debug = externalBaseName = "newTSO", functionType = FunctionType {paramTypes = [], returnTypes = [I32]} }, - FunctionImport - { internalName = "__asterius_setTSOret", - externalModuleName = "Scheduler", - externalBaseName = "setTSOret", - functionType = FunctionType - { paramTypes = [I32, F64], - returnTypes = [] - } - }, - FunctionImport - { internalName = "__asterius_setTSOrstat", - externalModuleName = "Scheduler", - externalBaseName = "setTSOrstat", - functionType = FunctionType - { paramTypes = [I32, I32], - returnTypes = [] - } - }, - FunctionImport - { internalName = "__asterius_getTSOret", - externalModuleName = "Scheduler", - externalBaseName = "getTSOret", - functionType = FunctionType - { paramTypes = [I32], - returnTypes = [F64] - } - }, FunctionImport { internalName = "__asterius_getTSOrstat", externalModuleName = "Scheduler", @@ -342,8 +296,8 @@ rtsFunctionImports debug = externalModuleName = "HeapAlloc", externalBaseName = "hpAlloc", functionType = FunctionType - { paramTypes = [F64], - returnTypes = [F64] + { paramTypes = [I32], + returnTypes = [I32] } }, FunctionImport @@ -351,8 +305,8 @@ rtsFunctionImports debug = externalModuleName = "HeapAlloc", externalBaseName = "allocate", functionType = FunctionType - { paramTypes = [F64], - returnTypes = [F64] + { paramTypes = [I32], + returnTypes = [I32] } }, FunctionImport @@ -360,8 +314,8 @@ rtsFunctionImports debug = externalModuleName = "HeapAlloc", externalBaseName = "allocatePinned", functionType = FunctionType - { paramTypes = [F64], - returnTypes = [F64] + { paramTypes = [I32], + returnTypes = [I32] } }, FunctionImport @@ -369,16 +323,16 @@ rtsFunctionImports debug = externalModuleName = "Memory", externalBaseName = "strlen", functionType = FunctionType - { paramTypes = [F64], - returnTypes = [F64] + { paramTypes = [I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_debugBelch2", + { internalName = "debugBelch2", externalModuleName = "Messages", externalBaseName = "debugBelch2", functionType = FunctionType - { paramTypes = [F64, F64], + { paramTypes = [I32, I32], returnTypes = [] } }, @@ -387,8 +341,8 @@ rtsFunctionImports debug = externalModuleName = "Memory", externalBaseName = "memchr", functionType = FunctionType - { paramTypes = [F64, F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32, I32], + returnTypes = [I32] } }, FunctionImport @@ -402,15 +356,15 @@ rtsFunctionImports debug = externalModuleName = "ExceptionHelper", externalBaseName = "raiseExceptionHelper", functionType = FunctionType - { paramTypes = [F64, F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32, I32], + returnTypes = [I32] } }, FunctionImport { internalName = "__asterius_enqueueTSO", externalModuleName = "Scheduler", externalBaseName = "enqueueTSO", - functionType = FunctionType {paramTypes = [F64], returnTypes = []} + functionType = FunctionType {paramTypes = [I32], returnTypes = []} }, FunctionImport { internalName = "__asterius_mul2", @@ -444,8 +398,8 @@ rtsFunctionImports debug = externalModuleName = "fs", externalBaseName = "read", functionType = FunctionType - { paramTypes = [F64, F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32, I32], + returnTypes = [I32] } }, FunctionImport @@ -453,48 +407,20 @@ rtsFunctionImports debug = externalModuleName = "fs", externalBaseName = "write", functionType = FunctionType - { paramTypes = [F64, F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32, I32], + returnTypes = [I32] } } ] <> ( if debug then - [ FunctionImport - { internalName = "__asterius_traceCmm", - externalModuleName = "Tracing", - externalBaseName = "traceCmm", - functionType = FunctionType - { paramTypes = [F64], - returnTypes = [] - } - }, - FunctionImport - { internalName = "__asterius_traceCmmBlock", - externalModuleName = "Tracing", - externalBaseName = "traceCmmBlock", - functionType = FunctionType - { paramTypes = [F64, I32], - returnTypes = [] - } - }, - FunctionImport - { internalName = "__asterius_traceCmmSetLocal", - externalModuleName = "Tracing", - externalBaseName = "traceCmmSetLocal", - functionType = FunctionType - { paramTypes = [F64, I32, F64], - returnTypes = [] - } - } - ] - <> concat + concat [ [ FunctionImport { internalName = "__asterius_load_" <> k, externalModuleName = "MemoryTrap", externalBaseName = "load" <> k, functionType = FunctionType - { paramTypes = [I64, I64, I32], + { paramTypes = [I32, I32, I32], returnTypes = [t] } }, @@ -503,7 +429,7 @@ rtsFunctionImports debug = externalModuleName = "MemoryTrap", externalBaseName = "store" <> k, functionType = FunctionType - { paramTypes = [I64, I64, I32, t], + { paramTypes = [I32, I32, I32, t], returnTypes = [] } } @@ -522,7 +448,7 @@ rtsFunctionImports debug = externalModuleName = "MemoryTrap", externalBaseName = "load" <> k1 <> s <> b, functionType = FunctionType - { paramTypes = [I64, I64, I32], + { paramTypes = [I32, I32, I32], returnTypes = [t1] } } @@ -584,17 +510,7 @@ rtsFunctionExports debug = | f <- ["getTSOret", "getTSOrstat"] ] <> [ FunctionExport {internalName = f, externalName = f} - | f <- - ( if debug - then - [ "__asterius_Load_Sp", - "__asterius_Load_SpLim", - "__asterius_Load_Hp", - "__asterius_Load_HpLim" - ] - else [] - ) - <> ["hs_init"] + | f <- ["hs_init"] ] <> [ FunctionExport { internalName = "stg_returnToSchedNotPaused", externalName = "stg_returnToSchedNotPaused" @@ -637,20 +553,20 @@ floatCBits = generateRTSWrapper "floatCBits" func_sym param_vts ret_vts ) ) - [ ("isFloatNegativeZero", [F32], [I64]), - ("isDoubleNegativeZero", [F64], [I64]), - ("isFloatNaN", [F32], [I64]), - ("isDoubleNaN", [F64], [I64]), - ("isFloatFinite", [F32], [I64]), - ("isDoubleFinite", [F64], [I64]), - ("isFloatDenormalized", [F32], [I64]), - ("isDoubleDenormalized", [F64], [I64]), - ("isFloatInfinite", [F32], [I64]), - ("isDoubleInfinite", [F64], [I64]), - ("__decodeFloat_Int", [I64, I64, F32], []), + [ ("isFloatNegativeZero", [F32], [I32]), + ("isDoubleNegativeZero", [F64], [I32]), + ("isFloatNaN", [F32], [I32]), + ("isDoubleNaN", [F64], [I32]), + ("isFloatFinite", [F32], [I32]), + ("isDoubleFinite", [F64], [I32]), + ("isFloatDenormalized", [F32], [I32]), + ("isDoubleDenormalized", [F64], [I32]), + ("isFloatInfinite", [F32], [I32]), + ("isDoubleInfinite", [F64], [I32]), + ("__decodeFloat_Int", [I32, I32, F32], []), ("rintDouble", [F64], [F64]), ("rintFloat", [F32], [F32]), - ("__decodeDouble_2Int", [I64, I64, I64, I64, F64], []) + ("__decodeDouble_2Int", [I32, I32, I32, I32, F64], []) ] generateRTSWrapper :: @@ -687,16 +603,11 @@ generateRTSWrapper mod_sym func_sym param_vts ret_vts = where xs = zipWith - ( \i vt -> case vt of - I64 -> - (F64, convertSInt64ToFloat64 GetLocal {index = i, valueType = I64}) - _ -> (vt, GetLocal {index = i, valueType = vt}) + ( \i vt -> (vt, GetLocal {index = i, valueType = vt}) ) [0 ..] param_vts - ret = case ret_vts of - [I64] -> ([F64], truncSFloat64ToInt64) - _ -> (ret_vts, id) + ret = (ret_vts, id) generateWrapperFunction :: EntitySymbol -> Function -> Function generateWrapperFunction func_sym Function {functionType = FunctionType {..}} = @@ -726,14 +637,10 @@ generateWrapperFunction func_sym Function {functionType = FunctionType {..}} = } where wrapper_param_types = - [ case param_type of - I64 -> (i, F64, truncSFloat64ToInt64) - _ -> (i, param_type, id) + [ (i, param_type, id) | (i, param_type) <- zip [0 ..] paramTypes ] - (wrapper_return_types, to_wrapper_return_types) = case returnTypes of - [I64] -> ([F64], convertSInt64ToFloat64) - _ -> (returnTypes, id) + (wrapper_return_types, to_wrapper_return_types) = (returnTypes, id) -- Renames each function in the module to _wrapper, and -- edits their implementation using 'generateWrapperFunction' @@ -751,42 +658,41 @@ initCapability = do storeI32 mainCapability offset_Capability_node $ constI32 0 storeI32 mainCapability offset_Capability_idle $ constI32 0 storeI8 mainCapability offset_Capability_disabled $ constI32 0 - storeI64 mainCapability offset_Capability_total_allocated $ constI64 0 - storeI64 + storeI32 mainCapability offset_Capability_total_allocated $ constI32 0 + storeI32 mainCapability (offset_Capability_f + offset_StgFunTable_stgEagerBlackholeInfo) $ symbol "__stg_EAGER_BLACKHOLE_info" - storeI64 mainCapability (offset_Capability_f + offset_StgFunTable_stgGCEnter1) $ + storeI32 mainCapability (offset_Capability_f + offset_StgFunTable_stgGCEnter1) $ symbol "__stg_gc_enter_1" - storeI64 mainCapability (offset_Capability_f + offset_StgFunTable_stgGCFun) $ + storeI32 mainCapability (offset_Capability_f + offset_StgFunTable_stgGCFun) $ symbol "__stg_gc_fun" - storeI64 mainCapability offset_Capability_weak_ptr_list_hd $ constI64 0 - storeI64 mainCapability offset_Capability_weak_ptr_list_tl $ constI64 0 + storeI32 mainCapability offset_Capability_weak_ptr_list_hd $ constI32 0 + storeI32 mainCapability offset_Capability_weak_ptr_list_tl $ constI32 0 storeI32 mainCapability offset_Capability_context_switch $ constI32 0 - storeI64 mainCapability (offset_Capability_r + offset_StgRegTable_rCCCS) $ - constI64 0 - storeI64 mainCapability (offset_Capability_r + offset_StgRegTable_rCurrentTSO) $ - constI64 0 + storeI32 mainCapability (offset_Capability_r + offset_StgRegTable_rCCCS) $ + constI32 0 + storeI32 mainCapability (offset_Capability_r + offset_StgRegTable_rCurrentTSO) $ + constI32 0 hsInitFunction :: BuiltinsOptions -> AsteriusModule hsInitFunction _ = runEDSL "hs_init" $ do initCapability - bd_nursery <- - truncUFloat64ToInt64 <$> callImport' "__asterius_hpAlloc" [constF64 8] F64 + bd_nursery <- callImport' "__asterius_hpAlloc" [constI32 4] I32 putLVal currentNursery bd_nursery rtsApplyFunction :: BuiltinsOptions -> AsteriusModule rtsApplyFunction _ = runEDSL "rts_apply" $ do - setReturnTypes [I64] - [f, arg] <- params [I64, I64] + setReturnTypes [I32] + [f, arg] <- params [I32, I32] ap <- call' "allocate" - [mainCapability, constI64 $ roundup_bytes_to_words sizeof_StgThunk + 2] - I64 - storeI64 ap 0 $ symbol "stg_ap_2_upd_info" - storeI64 ap offset_StgThunk_payload f - storeI64 ap (offset_StgThunk_payload + 8) arg + [mainCapability, constI32 $ roundup_bytes_to_words sizeof_StgThunk + 2] + I32 + storeI32 ap 0 $ symbol "stg_ap_2_upd_info" + storeI32 ap offset_StgThunk_payload f + storeI32 ap (offset_StgThunk_payload + 4) arg emit ap rtsGetSchedStatusFunction :: BuiltinsOptions -> AsteriusModule @@ -823,87 +729,87 @@ dirtySTACK _ stack = -- function scheduleTSOFunction :: BuiltinsOptions -> AsteriusModule scheduleTSOFunction BuiltinsOptions {} = runEDSL "scheduleTSO" $ do - tso <- param I64 + tso <- param I32 -- store the current TSO putLVal currentTSO tso -- indicate in the Capability that we are running the TSO -- TODO: remove all the useless Capability related stuff - storeI64 + storeI32 mainCapability (offset_Capability_r + offset_StgRegTable_rCurrentTSO) tso storeI32 mainCapability offset_Capability_interrupt $ constI32 0 storeI32 mainCapability offset_Capability_idle $ constI32 0 dirtyTSO mainCapability tso - dirtySTACK mainCapability (loadI64 tso offset_StgTSO_stackobj) + dirtySTACK mainCapability (loadI32 tso offset_StgTSO_stackobj) -- execute the TSO (using stgRun trampolining machinery) stgRun $ symbol "stg_returnToStackTop" -- indicate in the Capability that we are not running anything - storeI64 + storeI32 mainCapability (offset_Capability_r + offset_StgRegTable_rCurrentTSO) - (constI64 0) + (constI32 0) storeI32 mainCapability offset_Capability_interrupt $ constI32 1 storeI32 mainCapability offset_Capability_idle $ constI32 1 -- unset the current TSO - putLVal currentTSO (constI64 0) + putLVal currentTSO (constI32 0) -- Return the thread ID of the given tso getThreadIdFunction :: BuiltinsOptions -> AsteriusModule getThreadIdFunction BuiltinsOptions {} = runEDSL "rts_getThreadId" $ do - setReturnTypes [I64] - tso <- param I64 - emit (extendUInt32 (loadI32 tso offset_StgTSO_id)) + setReturnTypes [I32] + tso <- param I32 + emit (loadI32 tso offset_StgTSO_id) createThreadFunction :: BuiltinsOptions -> AsteriusModule createThreadFunction BuiltinsOptions {..} = runEDSL "createThread" $ do - setReturnTypes [I64] + setReturnTypes [I32] tso_p <- call' "allocatePinned" - [mainCapability, constI64 $ roundup_bytes_to_words sizeof_StgTSO] - I64 - stack_p <- call' "allocatePinned" [mainCapability, constI64 4096] I64 - storeI64 stack_p 0 $ symbol "stg_STACK_info" - stack_size_w <- i64Local $ constI64 $ (4096 - offset_StgStack_stack) `div` 8 - storeI32 stack_p offset_StgStack_stack_size $ wrapInt64 stack_size_w - storeI64 stack_p offset_StgStack_sp $ - (stack_p `addInt64` constI64 offset_StgStack_stack) - `addInt64` (stack_size_w `mulInt64` constI64 8) + [mainCapability, constI32 $ roundup_bytes_to_words sizeof_StgTSO] + I32 + stack_p <- call' "allocatePinned" [mainCapability, constI32 4096] I32 + storeI32 stack_p 0 $ symbol "stg_STACK_info" + stack_size_w <- local I32 $ constI32 $ (4096 - offset_StgStack_stack) `div` 4 + storeI32 stack_p offset_StgStack_stack_size stack_size_w + storeI32 stack_p offset_StgStack_sp $ + (stack_p `addInt32` constI32 offset_StgStack_stack) + `addInt32` (stack_size_w `mulInt32` constI32 4) storeI32 stack_p offset_StgStack_dirty $ constI32 1 - storeI64 tso_p 0 $ symbol "stg_TSO_info" + storeI32 tso_p 0 $ symbol "stg_TSO_info" storeI16 tso_p offset_StgTSO_what_next $ constI32 next_ThreadRunGHC storeI16 tso_p offset_StgTSO_why_blocked $ constI32 blocked_NotBlocked - storeI64 tso_p offset_StgTSO_blocked_exceptions $ + storeI32 tso_p offset_StgTSO_blocked_exceptions $ symbol "stg_END_TSO_QUEUE_closure" storeI32 tso_p offset_StgTSO_flags $ constI32 0 storeI32 tso_p offset_StgTSO_dirty $ constI32 1 storeI32 tso_p offset_StgTSO_saved_errno $ constI32 0 - storeI64 tso_p offset_StgTSO_cap mainCapability - storeI64 tso_p offset_StgTSO_stackobj stack_p - storeI32 tso_p offset_StgTSO_tot_stack_size $ wrapInt64 stack_size_w + storeI32 tso_p offset_StgTSO_cap mainCapability + storeI32 tso_p offset_StgTSO_stackobj stack_p + storeI32 tso_p offset_StgTSO_tot_stack_size stack_size_w storeI64 tso_p offset_StgTSO_alloc_limit (constI64 0) - storeI64 stack_p offset_StgStack_sp $ - loadI64 stack_p offset_StgStack_sp - `subInt64` constI64 (8 * roundup_bytes_to_words sizeof_StgStopFrame) - storeI64 (loadI64 stack_p offset_StgStack_sp) 0 $ + storeI32 stack_p offset_StgStack_sp $ + loadI32 stack_p offset_StgStack_sp + `subInt32` constI32 (4 * roundup_bytes_to_words sizeof_StgStopFrame) + storeI32 (loadI32 stack_p offset_StgStack_sp) 0 $ symbol "stg_stop_thread_info" callImport' "__asterius_newTSO" [] I32 >>= storeI32 tso_p offset_StgTSO_id emit tso_p pushClosure :: Expression -> Expression -> EDSL () pushClosure tso c = do - stack_p <- i64Local $ loadI64 tso offset_StgTSO_stackobj - storeI64 stack_p offset_StgStack_sp $ - loadI64 stack_p offset_StgStack_sp - `subInt64` constI64 8 - storeI64 (loadI64 stack_p offset_StgStack_sp) 0 c + stack_p <- local I32 $ loadI32 tso offset_StgTSO_stackobj + storeI32 stack_p offset_StgStack_sp $ + loadI32 stack_p offset_StgStack_sp + `subInt32` constI32 4 + storeI32 (loadI32 stack_p offset_StgStack_sp) 0 c createThreadHelper :: (Expression -> [Expression]) -> EDSL () createThreadHelper mk_closures = do - setReturnTypes [I64] - closure <- param I64 - t <- call' "createThread" [] I64 + setReturnTypes [I32] + closure <- param I32 + t <- call' "createThread" [] I32 for_ (mk_closures closure) $ pushClosure t emit t @@ -928,10 +834,10 @@ genAllocateFunction :: -- Module representing the function AsteriusModule genAllocateFunction (BuiltinsOptions {}) n = runEDSL n $ do - setReturnTypes [I64] - [_, m] <- params [I64, I64] - callImport' "__asterius_allocate" [convertUInt64ToFloat64 m] F64 - >>= emit . truncUFloat64ToInt64 + setReturnTypes [I32] + [_, m] <- params [I32, I32] + r <- callImport' "__asterius_allocate" [m] I32 + emit r {- allocateFunction BuiltinsOptions {} = @@ -944,27 +850,27 @@ allocateFunction BuiltinsOptions {} = -} allocatePinnedFunction :: BuiltinsOptions -> AsteriusModule allocatePinnedFunction _ = runEDSL "allocatePinned" $ do - setReturnTypes [I64] - [_, n] <- params [I64, I64] - callImport' "__asterius_allocatePinned" [convertUInt64ToFloat64 n] F64 - >>= emit . truncUFloat64ToInt64 + setReturnTypes [I32] + [_, n] <- params [I32, I32] + r <- callImport' "__asterius_allocatePinned" [n] I32 + emit r newCAFFunction :: BuiltinsOptions -> AsteriusModule newCAFFunction _ = runEDSL "newCAF" $ do - setReturnTypes [I64] - [reg, caf] <- params [I64, I64] - orig_info <- i64Local $ loadI64 caf 0 - storeI64 caf offset_StgIndStatic_saved_info orig_info + setReturnTypes [I32] + [reg, caf] <- params [I32, I32] + orig_info <- local I32 $ loadI32 caf 0 + storeI32 caf offset_StgIndStatic_saved_info orig_info bh <- call' "allocate" - [mainCapability, constI64 $ roundup_bytes_to_words sizeof_StgInd] - I64 - storeI64 bh 0 $ symbol "stg_CAF_BLACKHOLE_info" - storeI64 bh offset_StgInd_indirectee $ - loadI64 reg offset_StgRegTable_rCurrentTSO - storeI64 caf offset_StgIndStatic_indirectee bh - storeI64 caf 0 $ symbol "stg_IND_STATIC_info" + [mainCapability, constI32 $ roundup_bytes_to_words sizeof_StgInd] + I32 + storeI32 bh 0 $ symbol "stg_CAF_BLACKHOLE_info" + storeI32 bh offset_StgInd_indirectee $ + loadI32 reg offset_StgRegTable_rCurrentTSO + storeI32 caf offset_StgIndStatic_indirectee bh + storeI32 caf 0 $ symbol "stg_IND_STATIC_info" emit bh asterius_pc_global :: LVal @@ -972,7 +878,7 @@ asterius_pc_global = newGlobal "__asterius_pc" GlobalType - { globalValueType = I64, + { globalValueType = I32, globalMutability = Mutable } @@ -986,57 +892,57 @@ asterius_pc_global = stgRun :: Expression -> EDSL () stgRun init_f = do let pc = asterius_pc_global - pc_reg <- i64MutLocal + pc_reg <- mutLocal I32 putLVal pc init_f loop' [] $ \loop_lbl -> do putLVal pc_reg $ getLVal pc - if' [] (eqZInt64 (getLVal pc_reg)) mempty $ do + if' [] (eqZInt32 (getLVal pc_reg)) mempty $ do callIndirect (getLVal pc_reg) break' loop_lbl Nothing -- Return from a STG function stgReturnFunction :: BuiltinsOptions -> AsteriusModule stgReturnFunction _ = - runEDSL "StgReturn" $ putLVal asterius_pc_global $ constI64 0 -- store NULL in the __asterius_pc register. This will break stgRun + runEDSL "StgReturn" $ putLVal asterius_pc_global $ constI32 0 -- store NULL in the __asterius_pc register. This will break stgRun -- trampolining loop. getStablePtrWrapperFunction :: BuiltinsOptions -> AsteriusModule getStablePtrWrapperFunction _ = runEDSL "getStablePtr" $ do - setReturnTypes [I64] - obj64 <- param I64 - sp_f64 <- + setReturnTypes [I32] + obj32 <- param I32 + sp_i32 <- callImport' "__asterius_newStablePtr" - [convertUInt64ToFloat64 obj64] - F64 - emit $ truncUFloat64ToInt64 sp_f64 + [obj32] + I32 + emit sp_i32 deRefStablePtrWrapperFunction :: BuiltinsOptions -> AsteriusModule deRefStablePtrWrapperFunction _ = runEDSL "deRefStablePtr" $ do - setReturnTypes [I64] - sp64 <- param I64 - obj_f64 <- + setReturnTypes [I32] + sp32 <- param I32 + obj_i32 <- callImport' "__asterius_deRefStablePtr" - [convertUInt64ToFloat64 sp64] - F64 - emit $ truncUFloat64ToInt64 obj_f64 + [sp32] + I32 + emit obj_i32 freeStablePtrWrapperFunction :: BuiltinsOptions -> AsteriusModule freeStablePtrWrapperFunction _ = runEDSL "hs_free_stable_ptr" $ do - sp64 <- param I64 - callImport "__asterius_freeStablePtr" [convertUInt64ToFloat64 sp64] + sp32 <- param I32 + callImport "__asterius_freeStablePtr" [sp32] makeStableNameWrapperFunction :: BuiltinsOptions -> AsteriusModule makeStableNameWrapperFunction _ = runEDSL "makeStableName" $ do - setReturnTypes [I64] - sp64 <- param I64 - obj_f64 <- + setReturnTypes [I32] + sp32 <- param I32 + obj_i32 <- callImport' "__asterius_makeStableName" - [convertUInt64ToFloat64 sp64] - F64 - emit $ truncUFloat64ToInt64 obj_f64 + [sp32] + I32 + emit obj_i32 rtsMkHelper :: BuiltinsOptions -> @@ -1046,77 +952,49 @@ rtsMkHelper :: EntitySymbol -> AsteriusModule rtsMkHelper _ n con_sym = runEDSL n $ do - setReturnTypes [I64] - [i] <- params [I64] - p <- call' "allocate" [mainCapability, constI64 2] I64 - storeI64 p 0 $ symbol con_sym - storeI64 p 8 i + setReturnTypes [I32] + [i] <- params [I32] + p <- call' "allocate" [mainCapability, constI32 2] I32 + storeI32 p 0 $ symbol con_sym + storeI32 p 4 i emit p rtsMkBoolFunction :: BuiltinsOptions -> AsteriusModule rtsMkBoolFunction _ = runEDSL "rts_mkBool" $ do - setReturnTypes [I64] - [i] <- params [I64] + setReturnTypes [I32] + [i] <- params [I32] if' - [I64] - (eqZInt64 i) + [I32] + (eqZInt32 i) (emit $ symbol "ghczmprim_GHCziTypes_False_closure") (emit $ symbol "ghczmprim_GHCziTypes_True_closure") rtsMkDoubleFunction :: BuiltinsOptions -> AsteriusModule rtsMkDoubleFunction _ = runEDSL "rts_mkDouble" $ do - setReturnTypes [I64] + setReturnTypes [I32] [i] <- params [F64] - p <- call' "allocate" [mainCapability, constI64 2] I64 - storeI64 p 0 $ symbol "ghczmprim_GHCziTypes_Dzh_con_info" - storeF64 p 8 i + p <- call' "allocate" [mainCapability, constI32 3] I32 + storeI32 p 0 $ symbol "ghczmprim_GHCziTypes_Dzh_con_info" + storeF64 p 4 i emit p rtsMkCharFunction :: BuiltinsOptions -> AsteriusModule rtsMkCharFunction _ = runEDSL "rts_mkChar" $ do - setReturnTypes [I64] - [i] <- params [I64] - if' - [I64] - (i `ltUInt64` constI64 256) - -- If the character in question is in the range [0..255] we use the - -- trick that GHC uses, and instead of generating a heap-allocated Char - -- closure, we simply return the address of the statically allocated - -- Char. See stg_CHARLIKE_closure in - -- ghc-toolkit/boot-libs/rts/StgMiscClosures.cmm - ( let offset = i `mulInt64` constI64 16 - in emit $ symbol "stg_CHARLIKE_closure" `addInt64` offset - ) - -- Otherwise, we fall back to the more inefficient - -- approach and generate a dynamic closure. - $ do - p <- call' "allocate" [mainCapability, constI64 2] I64 - storeI64 p 0 $ symbol "ghczmprim_GHCziTypes_Czh_con_info" - storeI64 p 8 i - emit p + setReturnTypes [I32] + [i] <- params [I32] + p <- call' "allocate" [mainCapability, constI32 2] I32 + storeI32 p 0 $ symbol "ghczmprim_GHCziTypes_Czh_con_info" + storeI32 p 4 i + emit p rtsMkIntFunction :: BuiltinsOptions -> AsteriusModule rtsMkIntFunction _ = runEDSL "rts_mkInt" $ do - setReturnTypes [I64] - [i] <- params [I64] - if' - [I64] - ((i `leSInt64` constI64 16) `andInt32` (i `geSInt64` constI64 (-16))) - -- If the integer in question is in the range [-16..16] we use the - -- trick that GHC uses, and instead of generating a heap-allocated Int - -- closure, we simply return the address of the statically allocated - -- Int. See stg_INTLIKE_closure in - -- ghc-toolkit/boot-libs/rts/StgMiscClosures.cmm - ( let offset = (i `addInt64` constI64 16) `mulInt64` constI64 16 - in emit $ symbol "stg_INTLIKE_closure" `addInt64` offset - ) - -- Otherwise, we fall back to the more inefficient - -- approach and generate a dynamic closure. - $ do - p <- call' "allocate" [mainCapability, constI64 2] I64 - storeI64 p 0 $ symbol "ghczmprim_GHCziTypes_Izh_con_info" - storeI64 p 8 i - emit p + setReturnTypes [I32] + [i] <- params [I32] + p <- call' "allocate" [mainCapability, constI32 2] I32 + storeI32 p 0 $ symbol "ghczmprim_GHCziTypes_Izh_con_info" + storeI32 p 4 i + emit p rtsMkWordFunction :: BuiltinsOptions -> AsteriusModule rtsMkWordFunction opts = @@ -1136,17 +1014,16 @@ rtsMkJSValFunction opts = rtsGetBoolFunction :: BuiltinsOptions -> AsteriusModule rtsGetBoolFunction _ = runEDSL "rts_getBool" $ do - setReturnTypes [I64] - p <- param I64 - emit $ extendUInt32 $ - neInt32 + setReturnTypes [I32] + p <- param I32 + emit $ neInt32 (constI32 0) - (loadI32 (loadI64 (unTagClosure p) 0) offset_StgInfoTable_srt) + (loadI32 (loadI32 (unTagClosure p) 0) offset_StgInfoTable_srt) rtsGetDoubleFunction :: BuiltinsOptions -> AsteriusModule rtsGetDoubleFunction _ = runEDSL "rts_getDouble" $ do setReturnTypes [F64] - p <- param I64 + p <- param I32 emit $ loadF64 (unTagClosure p) offset_StgClosure_payload -- rtsGetCharFunction = rtsGetIntFunction @@ -1157,9 +1034,9 @@ generateRtsGetIntFunction :: EntitySymbol -> -- Name of the function AsteriusModule generateRtsGetIntFunction _ n = runEDSL n $ do - setReturnTypes [I64] - p <- param I64 - emit $ loadI64 (unTagClosure p) offset_StgClosure_payload + setReturnTypes [I32] + p <- param I32 + emit $ loadI32 (unTagClosure p) offset_StgClosure_payload {- rtsGetIntFunction _ = @@ -1171,99 +1048,70 @@ rtsGetIntFunction _ = loadI64Function :: BuiltinsOptions -> AsteriusModule loadI64Function _ = runEDSL "loadI64" $ do setReturnTypes [I64] - p <- param I64 + p <- param I32 emit $ loadI64 p 0 -printI64Function :: BuiltinsOptions -> AsteriusModule -printI64Function _ = runEDSL "print_i64" $ do - x <- param I64 - callImport "printI64" [convertSInt64ToFloat64 x] - -assertEqI64Function :: BuiltinsOptions -> AsteriusModule -assertEqI64Function _ = runEDSL "assert_eq_i64" $ do - x <- param I64 - y <- param I64 - callImport "assertEqI64" [convertSInt64ToFloat64 x, convertSInt64ToFloat64 y] - -printF32Function :: BuiltinsOptions -> AsteriusModule -printF32Function _ = runEDSL "print_f32" $ do - x <- param F32 - callImport "printF32" [x] - -printF64Function :: BuiltinsOptions -> AsteriusModule -printF64Function _ = runEDSL "print_f64" $ do - x <- param F64 - callImport "printF64" [x] - strlenFunction :: BuiltinsOptions -> AsteriusModule strlenFunction _ = runEDSL "strlen" $ do - setReturnTypes [I64] - [str] <- params [I64] - len <- callImport' "__asterius_strlen" [convertUInt64ToFloat64 str] F64 - emit $ truncUFloat64ToInt64 len - -debugBelch2Function :: BuiltinsOptions -> AsteriusModule -debugBelch2Function _ = runEDSL "debugBelch2" $ do - [fmt, str] <- params [I64, I64] - callImport - "__asterius_debugBelch2" - [convertUInt64ToFloat64 fmt, convertUInt64ToFloat64 str] + setReturnTypes [I32] + [str] <- params [I32] + len <- callImport' "__asterius_strlen" [str] I32 + emit len memchrFunction :: BuiltinsOptions -> AsteriusModule memchrFunction _ = runEDSL "memchr" $ do - setReturnTypes [I64] - [ptr, val, num] <- params [I64, I64, I64] + setReturnTypes [I32] + [ptr, val, num] <- params [I32, I32, I32] p <- callImport' "__asterius_memchr" - (map convertUInt64ToFloat64 [ptr, val, num]) - F64 - emit $ truncUFloat64ToInt64 p + [ptr, val, num] + I32 + emit p threadPausedFunction :: BuiltinsOptions -> AsteriusModule threadPausedFunction _ = runEDSL "threadPaused" $ do - _ <- params [I64, I64] + _ <- params [I32, I32] pure () dirtyMutVarFunction :: BuiltinsOptions -> AsteriusModule dirtyMutVarFunction _ = runEDSL "dirty_MUT_VAR" $ do - [_, p, _] <- params [I64, I64, I64] + [_, p, _] <- params [I32, I32, I32] if' [] - (loadI64 p 0 `eqInt64` symbol "stg_MUT_VAR_CLEAN_info") - (storeI64 p 0 $ symbol "stg_MUT_VAR_DIRTY_info") + (loadI32 p 0 `eqInt32` symbol "stg_MUT_VAR_CLEAN_info") + (storeI32 p 0 $ symbol "stg_MUT_VAR_DIRTY_info") mempty dirtyMVarFunction :: BuiltinsOptions -> AsteriusModule dirtyMVarFunction _ = runEDSL "dirty_MVAR" $ do - [_basereg, _mvar, _] <- params [I64, I64, I64] + [_basereg, _mvar, _] <- params [I32, I32, I32] mempty dirtyStackFunction :: BuiltinsOptions -> AsteriusModule dirtyStackFunction _ = runEDSL "dirty_STACK" $ do - [cap, stack] <- params [I64, I64] + [cap, stack] <- params [I32, I32] dirtySTACK cap stack recordClosureMutatedFunction :: BuiltinsOptions -> AsteriusModule recordClosureMutatedFunction _ = runEDSL "recordClosureMutated" $ do - [_cap, _closure] <- params [I64, I64] + [_cap, _closure] <- params [I32, I32] mempty tryWakeupThreadFunction :: BuiltinsOptions -> AsteriusModule tryWakeupThreadFunction _ = runEDSL "tryWakeupThread" $ do - [_cap, tso] <- params [I64, I64] - callImport "__asterius_enqueueTSO" [convertUInt64ToFloat64 tso] + [_cap, tso] <- params [I32, I32] + callImport "__asterius_enqueueTSO" [tso] raiseExceptionHelperFunction :: BuiltinsOptions -> AsteriusModule raiseExceptionHelperFunction _ = runEDSL "raiseExceptionHelper" $ do - setReturnTypes [I64] - args <- params [I64, I64, I64] + setReturnTypes [I32] + args <- params [I32, I32, I32] frame_type <- - truncUFloat64ToInt64 - <$> callImport' + callImport' "__asterius_raiseExceptionHelper" - (map convertUInt64ToFloat64 args) - F64 + args + I32 emit frame_type -- Note that generateRTSWrapper will treat all our numbers as signed, not @@ -1278,40 +1126,40 @@ unicodeCBits = generateRTSWrapper "Unicode" func_sym param_vts ret_vts ) ) - [ ("u_gencat", [I64], [I64]), - ("u_iswalpha", [I64], [I64]), - ("u_iswalnum", [I64], [I64]), - ("u_iswupper", [I64], [I64]), - ("u_iswlower", [I64], [I64]), - ("u_towlower", [I64], [I64]), - ("u_towupper", [I64], [I64]), - ("u_towtitle", [I64], [I64]), - ("u_iswcntrl", [I64], [I64]), - ("u_iswprint", [I64], [I64]) + [ ("u_gencat", [I32], [I32]), + ("u_iswalpha", [I32], [I32]), + ("u_iswalnum", [I32], [I32]), + ("u_iswupper", [I32], [I32]), + ("u_iswlower", [I32], [I32]), + ("u_towlower", [I32], [I32]), + ("u_towupper", [I32], [I32]), + ("u_towtitle", [I32], [I32]), + ("u_iswcntrl", [I32], [I32]), + ("u_iswprint", [I32], [I32]) ] suspendThreadFunction :: BuiltinsOptions -> AsteriusModule suspendThreadFunction _ = runEDSL "suspendThread" $ do - setReturnTypes [I64] - [reg, _] <- params [I64, I64] + setReturnTypes [I32] + [reg, _] <- params [I32, I32] emit reg scheduleThreadFunction :: BuiltinsOptions -> AsteriusModule scheduleThreadFunction _ = runEDSL "scheduleThread" $ do setReturnTypes [] - [_cap, tso] <- params [I64, I64] - callImport "__asterius_enqueueTSO" [convertUInt64ToFloat64 tso] + [_cap, tso] <- params [I32, I32] + callImport "__asterius_enqueueTSO" [tso] scheduleThreadOnFunction :: BuiltinsOptions -> AsteriusModule scheduleThreadOnFunction _ = runEDSL "scheduleThreadOn" $ do setReturnTypes [] - [_cap, _cpu, tso] <- params [I64, I64, I64] - callImport "__asterius_enqueueTSO" [convertUInt64ToFloat64 tso] + [_cap, _cpu, tso] <- params [I32, I32, I32] + callImport "__asterius_enqueueTSO" [tso] resumeThreadFunction :: BuiltinsOptions -> AsteriusModule resumeThreadFunction _ = runEDSL "resumeThread" $ do - setReturnTypes [I64] - reg <- param I64 + setReturnTypes [I32] + reg <- param I32 emit reg performMajorGCFunction :: BuiltinsOptions -> AsteriusModule @@ -1323,63 +1171,50 @@ performGCFunction _ = runEDSL "performGC" $ call "performMajorGC" [] localeEncodingFunction :: BuiltinsOptions -> AsteriusModule localeEncodingFunction _ = runEDSL "localeEncoding" $ do - setReturnTypes [I64] + setReturnTypes [I32] emit $ symbol "__asterius_localeEncoding" isattyFunction :: BuiltinsOptions -> AsteriusModule isattyFunction _ = runEDSL "isatty" $ do - setReturnTypes [I64] - _ <- param I64 - emit $ constI64 0 + setReturnTypes [I32] + _ <- param I32 + emit $ constI32 0 fdReadyFunction :: BuiltinsOptions -> AsteriusModule fdReadyFunction _ = runEDSL "fdReady" $ do - setReturnTypes [I64] - _ <- params [I64, I64, I64, I64] - emit $ constI64 1 + setReturnTypes [I32] + _ <- params [I32, I32, I64, I32] + emit $ constI32 1 rtsSupportsBoundThreadsFunction :: BuiltinsOptions -> AsteriusModule rtsSupportsBoundThreadsFunction _ = runEDSL "rtsSupportsBoundThreads" $ do - setReturnTypes [I64] - emit $ constI64 0 + setReturnTypes [I32] + emit $ constI32 0 readFunction :: BuiltinsOptions -> AsteriusModule readFunction _ = runEDSL "ghczuwrapperZC22ZCbaseZCSystemziPosixziInternalsZCread" $ do - setReturnTypes [I64] - [fd, buf, count] <- params [I64, I64, I64] + setReturnTypes [I32] + [fd, buf, count] <- params [I32, I32, I32] r <- - truncSFloat64ToInt64 - <$> callImport' + callImport' "__asterius_read" - (map convertUInt64ToFloat64 [fd, buf, count]) - F64 + [fd, buf, count] + I32 emit r writeFunction :: BuiltinsOptions -> AsteriusModule writeFunction _ = runEDSL "ghczuwrapperZC20ZCbaseZCSystemziPosixziInternalsZCwrite" $ do - setReturnTypes [I64] - [fd, buf, count] <- params [I64, I64, I64] + setReturnTypes [I32] + [fd, buf, count] <- params [I32, I32, I32] r <- - truncSFloat64ToInt64 - <$> callImport' + callImport' "__asterius_write" - (map convertUInt64ToFloat64 [fd, buf, count]) - F64 + [fd, buf, count] + I32 emit r -getF64GlobalRegFunction :: - BuiltinsOptions -> - -- Name of the function to be created - EntitySymbol -> - -- Global register to be returned - UnresolvedGlobalReg -> - AsteriusModule -- Module containing the function -getF64GlobalRegFunction _ n gr = runEDSL n $ do - setReturnTypes [F64] - emit $ convertSInt64ToFloat64 $ getLVal $ global gr - -- @cheng: there is a trade-off here: Either I emit the low-level -- store and load, or I expose a _lot more_ from the EDSL -- to create the correct types of stores and loads I want. @@ -1403,7 +1238,7 @@ genWrap ti b x = Block [ Store { bytes = if ti == I32 then 4 else 8, offset = 0, - ptr = wrapInt64 (symbol "__asterius_i64_slot"), + ptr = (symbol "__asterius_i64_slot"), value = x, valueType = ti }, @@ -1412,7 +1247,7 @@ genWrap ti b x = Block bytes = fromIntegral b, offset = 0, valueType = I32, - ptr = wrapInt64 (symbol "__asterius_i64_slot") + ptr = (symbol "__asterius_i64_slot") } ], blockReturnTypes = [I32] @@ -1445,7 +1280,7 @@ genExtend b to sext x = Block [ Store { bytes = 4, offset = 0, - ptr = wrapInt64 (symbol "__asterius_i64_slot"), + ptr = symbol "__asterius_i64_slot", value = x, valueType = I32 }, @@ -1454,7 +1289,7 @@ genExtend b to sext x = Block bytes = fromIntegral b, offset = 0, valueType = to, - ptr = wrapInt64 (symbol "__asterius_i64_slot") + ptr = symbol "__asterius_i64_slot" } ], blockReturnTypes = [to] diff --git a/asterius/src/Asterius/Builtins/Barf.hs b/asterius/src/Asterius/Builtins/Barf.hs index dd14a3b4..cc9ff8b9 100644 --- a/asterius/src/Asterius/Builtins/Barf.hs +++ b/asterius/src/Asterius/Builtins/Barf.hs @@ -3,20 +3,18 @@ module Asterius.Builtins.Barf ( barfImports, - barfCBits, ) where -import Asterius.EDSL import Asterius.Types barfImports :: [FunctionImport] barfImports = [ FunctionImport - { internalName = "__asterius_barf", + { internalName = "barf", externalModuleName = "ExceptionHelper", externalBaseName = "barf", - functionType = FunctionType {paramTypes = [F64], returnTypes = []} + functionType = FunctionType {paramTypes = [I32], returnTypes = []} }, FunctionImport { internalName = "barf_push", @@ -31,11 +29,3 @@ barfImports = functionType = FunctionType {paramTypes = [I32], returnTypes = []} } ] - -barfCBits :: AsteriusModule -barfCBits = barfFunction - -barfFunction :: AsteriusModule -barfFunction = runEDSL "barf" $ do - s <- param I64 - callImport "__asterius_barf" [convertUInt64ToFloat64 s] diff --git a/asterius/src/Asterius/Builtins/Blackhole.hs b/asterius/src/Asterius/Builtins/Blackhole.hs index 9efcb1d5..2ddfb99b 100644 --- a/asterius/src/Asterius/Builtins/Blackhole.hs +++ b/asterius/src/Asterius/Builtins/Blackhole.hs @@ -16,31 +16,31 @@ blackholeCBits = messageBlackHole <> updateThunk messageBlackHole :: AsteriusModule messageBlackHole = runEDSL "messageBlackHole" $ do - setReturnTypes [I64] - [_, msg] <- params [I64, I64] - bh <- i64Local $ unTagClosure $ loadI64 msg offset_MessageBlackHole_bh - p <- i64Local $ unTagClosure $ loadI64 bh offset_StgInd_indirectee - info <- i64Local $ loadI64 p 0 + setReturnTypes [I32] + [_, msg] <- params [I32, I32] + bh <- local I32 $ unTagClosure $ loadI32 msg offset_MessageBlackHole_bh + p <- local I32 $ unTagClosure $ loadI32 bh offset_StgInd_indirectee + info <- local I32 $ loadI32 p 0 if' [] (checkSymbol info ["stg_TSO_info"]) ( do - storeI64 msg offset_MessageBlackHole_link $ + storeI32 msg offset_MessageBlackHole_link $ symbol "stg_END_TSO_QUEUE_closure" bq <- call' "allocate" [ mainCapability, - constI64 $ roundup_bytes_to_words sizeof_StgBlockingQueue + constI32 $ roundup_bytes_to_words sizeof_StgBlockingQueue ] - I64 - storeI64 bq 0 $ symbol "stg_BLOCKING_QUEUE_DIRTY_info" - storeI64 bq offset_StgBlockingQueue_link $ + I32 + storeI32 bq 0 $ symbol "stg_BLOCKING_QUEUE_DIRTY_info" + storeI32 bq offset_StgBlockingQueue_link $ symbol "stg_END_TSO_QUEUE_closure" - storeI64 bq offset_StgBlockingQueue_bh bh - storeI64 bq offset_StgBlockingQueue_owner p - storeI64 bq offset_StgBlockingQueue_queue msg - storeI64 bh offset_StgInd_indirectee bq + storeI32 bq offset_StgBlockingQueue_bh bh + storeI32 bq offset_StgBlockingQueue_owner p + storeI32 bq offset_StgBlockingQueue_queue msg + storeI32 bh offset_StgInd_indirectee bq ) ( if' [] @@ -50,18 +50,18 @@ messageBlackHole = runEDSL "messageBlackHole" $ do ) ( do let bq = p - storeI64 msg offset_MessageBlackHole_link $ - loadI64 bq offset_StgBlockingQueue_queue - storeI64 bq offset_StgBlockingQueue_queue msg + storeI32 msg offset_MessageBlackHole_link $ + loadI32 bq offset_StgBlockingQueue_queue + storeI32 bq offset_StgBlockingQueue_queue msg ) (emitErrorMsg "messageBlackHole: weird blackhole") ) - emit $ constI64 1 + emit $ constI32 1 updateThunk :: AsteriusModule updateThunk = runEDSL "updateThunk" $ do - [cap, tso, thunk, val] <- params [I64, I64, I64, I64] - thunk_info <- i64Local $ loadI64 thunk 0 + [cap, tso, thunk, val] <- params [I32, I32, I32, I32] + thunk_info <- local I32 $ loadI32 thunk 0 if' [] ( checkSymbol @@ -70,14 +70,14 @@ updateThunk = runEDSL "updateThunk" $ do ) (pure ()) (emitErrorMsg "updateThunk: weird thunk") - tso_or_bq <- i64Local $ unTagClosure $ loadI64 thunk offset_StgInd_indirectee - tso_or_bq_info <- i64Local $ loadI64 tso_or_bq 0 + tso_or_bq <- local I32 $ unTagClosure $ loadI32 thunk offset_StgInd_indirectee + tso_or_bq_info <- local I32 $ loadI32 tso_or_bq 0 if' [] (checkSymbol tso_or_bq_info ["stg_TSO_info"]) ( do - storeI64 thunk 0 $ symbol "stg_BLACKHOLE_info" - storeI64 thunk offset_StgInd_indirectee val + storeI32 thunk 0 $ symbol "stg_BLACKHOLE_info" + storeI32 thunk offset_StgInd_indirectee val ) ( do let bq = tso_or_bq @@ -91,27 +91,27 @@ updateThunk = runEDSL "updateThunk" $ do (emitErrorMsg "updateThunk: weird thunk payload") if' [] - (tso `eqInt64` loadI64 bq offset_StgBlockingQueue_owner) + (tso `eqInt32` loadI32 bq offset_StgBlockingQueue_owner) (pure ()) (emitErrorMsg "updateThunk: not my thunk") - storeI64 thunk 0 $ symbol "stg_BLACKHOLE_info" - storeI64 thunk offset_StgInd_indirectee val - msg_p <- i64MutLocal + storeI32 thunk 0 $ symbol "stg_BLACKHOLE_info" + storeI32 thunk offset_StgInd_indirectee val + msg_p <- mutLocal I32 let msg = getLVal msg_p - putLVal msg_p $ loadI64 bq offset_StgBlockingQueue_queue - whileLoop (msg `neInt64` symbol "stg_END_TSO_QUEUE_closure") $ do - blocked_tso <- i64Local $ loadI64 msg offset_MessageBlackHole_tso + putLVal msg_p $ loadI32 bq offset_StgBlockingQueue_queue + whileLoop (msg `neInt32` symbol "stg_END_TSO_QUEUE_closure") $ do + blocked_tso <- local I32 $ loadI32 msg offset_MessageBlackHole_tso if' [] - (checkSymbol (loadI64 blocked_tso 0) ["stg_TSO_info"]) + (checkSymbol (loadI32 blocked_tso 0) ["stg_TSO_info"]) (pure ()) (emitErrorMsg "updateThunk: weird queued TSO") call "tryWakeupThread" [cap, blocked_tso] - putLVal msg_p $ loadI64 msg offset_MessageBlackHole_link + putLVal msg_p $ loadI32 msg offset_MessageBlackHole_link ) checkSymbol :: Expression -> [EntitySymbol] -> Expression -checkSymbol e syms = foldl1' orInt32 $ map ((e `eqInt64`) . symbol) syms +checkSymbol e syms = foldl1' orInt32 $ map ((e `eqInt32`) . symbol) syms emitErrorMsg :: BS.ByteString -> EDSL () emitErrorMsg msg = emit Barf {barfMessage = msg, barfReturnTypes = []} diff --git a/asterius/src/Asterius/Builtins/Env.hs b/asterius/src/Asterius/Builtins/Env.hs index a2b2983e..a09def80 100644 --- a/asterius/src/Asterius/Builtins/Env.hs +++ b/asterius/src/Asterius/Builtins/Env.hs @@ -19,7 +19,7 @@ envImports = externalBaseName = "getProgArgv", functionType = FunctionType - { paramTypes = [F64, F64], + { paramTypes = [I32, I32], returnTypes = [] } } @@ -47,8 +47,7 @@ envArgvBuf = envGetProgArgv :: AsteriusModule envGetProgArgv = runEDSL "getProgArgv" $ do - [argc, argv] <- params [I64, I64] - callImport "__asterius_getProgArgv" $ - map convertUInt64ToFloat64 [argc, symbol "__asterius_argv_buf"] - storeI64 (symbol "__asterius_argv_buf") 0 (symbol "prog_name") - storeI64 argv 0 $ symbol "__asterius_argv_buf" + [argc, argv] <- params [I32, I32] + callImport "__asterius_getProgArgv" [argc, symbol "__asterius_argv_buf"] + storeI32 (symbol "__asterius_argv_buf") 0 (symbol "prog_name") + storeI32 argv 0 $ symbol "__asterius_argv_buf" diff --git a/asterius/src/Asterius/Builtins/Exports.hs b/asterius/src/Asterius/Builtins/Exports.hs index 2b549e49..731663b8 100644 --- a/asterius/src/Asterius/Builtins/Exports.hs +++ b/asterius/src/Asterius/Builtins/Exports.hs @@ -3,48 +3,27 @@ module Asterius.Builtins.Exports ( exportsImports, - exportsCBits, ) where -import Asterius.EDSL import Asterius.Types exportsImports :: [FunctionImport] exportsImports = [ FunctionImport - { internalName = "__asterius_newHaskellCallback", + { internalName = "newHaskellCallback", externalModuleName = "Exports", externalBaseName = "newHaskellCallback", functionType = FunctionType - { paramTypes = [F64, F64, F64, F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32, I32, I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_freeHaskellCallback", + { internalName = "freeHaskellCallback", externalModuleName = "Exports", externalBaseName = "freeHaskellCallback", - functionType = FunctionType {paramTypes = [F64], returnTypes = []} + functionType = FunctionType {paramTypes = [I32], returnTypes = []} } ] - -exportsCBits :: AsteriusModule -exportsCBits = newHaskellCallback <> freeHaskellCallback - -newHaskellCallback :: AsteriusModule -newHaskellCallback = runEDSL "newHaskellCallback" $ do - setReturnTypes [I64] - args <- params [I64, I64, I64, I64, I64] - truncUFloat64ToInt64 - <$> callImport' - "__asterius_newHaskellCallback" - (map convertUInt64ToFloat64 args) - F64 - >>= emit - -freeHaskellCallback :: AsteriusModule -freeHaskellCallback = runEDSL "freeHaskellCallback" $ do - arg <- param I64 - callImport "__asterius_freeHaskellCallback" [convertUInt64ToFloat64 arg] diff --git a/asterius/src/Asterius/Builtins/Posix.hs b/asterius/src/Asterius/Builtins/Posix.hs index 626dc8a3..a8a6bf43 100644 --- a/asterius/src/Asterius/Builtins/Posix.hs +++ b/asterius/src/Asterius/Builtins/Posix.hs @@ -24,68 +24,68 @@ import System.Posix.Internals posixImports :: [FunctionImport] posixImports = [ FunctionImport - { internalName = "__asterius_posix_get_errno", + { internalName = "__hscore_get_errno", externalModuleName = "posix", externalBaseName = "get_errno", - functionType = FunctionType {paramTypes = [], returnTypes = [F64]} + functionType = FunctionType {paramTypes = [], returnTypes = [I32]} }, FunctionImport - { internalName = "__asterius_posix_set_errno", + { internalName = "__hscore_set_errno", externalModuleName = "posix", externalBaseName = "set_errno", - functionType = FunctionType {paramTypes = [F64], returnTypes = []} + functionType = FunctionType {paramTypes = [I32], returnTypes = []} }, FunctionImport - { internalName = "__asterius_posix_open", + { internalName = "__hscore_open", externalModuleName = "posix", externalBaseName = "open", functionType = FunctionType - { paramTypes = [F64, F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_posix_close", + { internalName = "close", externalModuleName = "posix", externalBaseName = "close", - functionType = FunctionType {paramTypes = [F64], returnTypes = [F64]} + functionType = FunctionType {paramTypes = [I32], returnTypes = [I32]} }, FunctionImport - { internalName = "__asterius_posix_ftruncate", + { internalName = "__hscore_ftruncate", externalModuleName = "posix", externalBaseName = "ftruncate", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_posix_stat", + { internalName = "__hscore_stat", externalModuleName = "posix", externalBaseName = "stat", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_posix_fstat", + { internalName = "__hscore_fstat", externalModuleName = "posix", externalBaseName = "fstat", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport { internalName = "__asterius_posix_opendir", externalModuleName = "posix", externalBaseName = "opendir", - functionType = FunctionType {paramTypes = [F64], returnTypes = [F64]} + functionType = FunctionType {paramTypes = [I32], returnTypes = [I32]} }, FunctionImport { internalName = "__asterius_posix_readdir", @@ -93,15 +93,15 @@ posixImports = externalBaseName = "readdir", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_posix_closedir", + { internalName = "closedir", externalModuleName = "posix", externalBaseName = "closedir", - functionType = FunctionType {paramTypes = [F64], returnTypes = [F64]} + functionType = FunctionType {paramTypes = [I32], returnTypes = [I32]} }, FunctionImport { internalName = "__asterius_posix_getenv", @@ -109,108 +109,46 @@ posixImports = externalBaseName = "getenv", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_posix_access", + { internalName = "access", externalModuleName = "posix", externalBaseName = "access", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_posix_getcwd", + { internalName = "getcwd", externalModuleName = "posix", externalBaseName = "getcwd", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } } ] posixCBits :: AsteriusModule posixCBits = - posixOpen - <> posixClose - <> posixFtruncate - <> posixStat - <> posixFstat - <> posixFstatGetters + posixFstatGetters <> posixModeGetters <> posixConstants <> posixLockFile <> posixUnlockFile <> posixOpendir - <> posixGetErrno - <> posixSetErrno <> posixDirentBuf <> posixReaddir <> posixFreeDirent <> posixDName - <> posixClosedir <> posixGetenvBuf <> posixGetenv - <> posixAccess - <> posixGetcwd - -posixOpen :: AsteriusModule -posixOpen = runEDSL "__hscore_open" $ do - setReturnTypes [I64] - args <- params [I64, I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_posix_open" - (map convertSInt64ToFloat64 args) - F64 - >>= emit - -posixClose :: AsteriusModule -posixClose = runEDSL "close" $ do - setReturnTypes [I64] - fd <- param I64 - truncSFloat64ToInt64 - <$> callImport' "__asterius_posix_close" [convertSInt64ToFloat64 fd] F64 - >>= emit - -posixFtruncate :: AsteriusModule -posixFtruncate = runEDSL "__hscore_ftruncate" $ do - setReturnTypes [I64] - args <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_posix_ftruncate" - (map convertSInt64ToFloat64 args) - F64 - >>= emit - -posixStat :: AsteriusModule -posixStat = runEDSL "__hscore_stat" $ do - setReturnTypes [I64] - args <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_posix_stat" - (map convertSInt64ToFloat64 args) - F64 - >>= emit - -posixFstat :: AsteriusModule -posixFstat = runEDSL "__hscore_fstat" $ do - setReturnTypes [I64] - args <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_posix_fstat" - (map convertSInt64ToFloat64 args) - F64 - >>= emit posixFstatGetters :: AsteriusModule posixFstatGetters = @@ -221,19 +159,19 @@ posixFstatGetters = Function { functionType = FunctionType - { paramTypes = [I64], - returnTypes = [I64] + { paramTypes = [I32], + returnTypes = [t] }, varTypes = [], - body = loadI64 GetLocal {index = 0, valueType = I64} v + body = f $ loadI32 GetLocal {index = 0, valueType = I32} v } ) - | (k, v) <- - [ ("__hscore_st_mtime", offset_stat_mtime), - ("__hscore_st_size", offset_stat_size), - ("__hscore_st_mode", offset_stat_mode), - ("__hscore_st_dev", offset_stat_dev), - ("__hscore_st_ino", offset_stat_ino) + | (k, v, t, f) <- + [ ("__hscore_st_mtime", offset_stat_mtime, I32, id), + ("__hscore_st_size", offset_stat_size, I64, extendUInt32), + ("__hscore_st_mode", offset_stat_mode, I32, id), + ("__hscore_st_dev", offset_stat_dev, I64, extendUInt32), + ("__hscore_st_ino", offset_stat_ino, I64, extendUInt32) ] ] } @@ -247,16 +185,15 @@ posixModeGetters = Function { functionType = FunctionType - { paramTypes = [I64], - returnTypes = [I64] + { paramTypes = [I32], + returnTypes = [I32] }, varTypes = [], body = - extendUInt32 $ - ( GetLocal {index = 0, valueType = I64} - `andInt64` constI64 0o0170000 + ( GetLocal {index = 0, valueType = I32} + `andInt32` constI32 0o0170000 ) - `eqInt64` constI64 v + `eqInt32` constI32 v } ) | (k, v) <- @@ -279,10 +216,10 @@ posixConstants = { functionType = FunctionType { paramTypes = [], - returnTypes = [I64] + returnTypes = [I32] }, varTypes = [], - body = constI64 v + body = constI32 v } ) | (k, v) <- @@ -321,13 +258,13 @@ offset_stat_mtime, posixLockFile, posixUnlockFile :: AsteriusModule posixLockFile = runEDSL "lockFile" $ do - setReturnTypes [I64] - _ <- params [I64, I64, I64, I64] - emit $ constI64 0 + setReturnTypes [I32] + _ <- params [I32, I32, I32, I32] + emit $ constI32 0 posixUnlockFile = runEDSL "unlockFile" $ do - setReturnTypes [I64] - _ <- params [I64] - emit $ constI64 0 + setReturnTypes [I32] + _ <- params [I32] + emit $ constI32 0 {-# NOINLINE unixUnitId #-} unixUnitId :: BS.ByteString @@ -342,27 +279,14 @@ posixOpendir = <> "ZCSystemziPosixziDirectoryZCopendir" ) $ do - setReturnTypes [I64] - p <- param I64 - truncSFloat64ToInt64 - <$> callImport' + setReturnTypes [I32] + p <- param I32 + callImport' "__asterius_posix_opendir" - [convertSInt64ToFloat64 p] - F64 + [p] + I32 >>= emit -posixGetErrno :: AsteriusModule -posixGetErrno = runEDSL "__hscore_get_errno" $ do - setReturnTypes [I64] - truncSFloat64ToInt64 - <$> callImport' "__asterius_posix_get_errno" [] F64 - >>= emit - -posixSetErrno :: AsteriusModule -posixSetErrno = runEDSL "__hscore_set_errno" $ do - e <- param I64 - callImport "__asterius_posix_set_errno" [convertSInt64ToFloat64 e] - posixDirentBuf :: AsteriusModule posixDirentBuf = mempty @@ -377,38 +301,26 @@ posixDirentBuf = posixReaddir :: AsteriusModule posixReaddir = runEDSL "__hscore_readdir" $ do - setReturnTypes [I64] - [dirPtr, pDirEnt] <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' + setReturnTypes [I32] + [dirPtr, pDirEnt] <- params [I32, I32] + callImport' "__asterius_posix_readdir" - ( map - convertSInt64ToFloat64 - [dirPtr, symbol "__asterius_posix_dirent_buf"] - ) - F64 - >>= storeI64 pDirEnt 0 - emit $ constI64 0 + [dirPtr, symbol "__asterius_posix_dirent_buf"] + I32 + >>= storeI32 pDirEnt 0 + emit $ constI32 0 posixFreeDirent :: AsteriusModule posixFreeDirent = runEDSL "__hscore_free_dirent" $ do - _ <- param I64 + _ <- param I32 pure () posixDName :: AsteriusModule posixDName = runEDSL "__hscore_d_name" $ do - setReturnTypes [I64] - _ <- param I64 + setReturnTypes [I32] + _ <- param I32 emit $ symbol "__asterius_posix_dirent_buf" -posixClosedir :: AsteriusModule -posixClosedir = runEDSL "closedir" $ do - setReturnTypes [I64] - p <- param I64 - truncSFloat64ToInt64 - <$> callImport' "__asterius_posix_closedir" [convertSInt64ToFloat64 p] F64 - >>= emit - posixGetenvBuf :: AsteriusModule posixGetenvBuf = mempty @@ -423,33 +335,10 @@ posixGetenvBuf = posixGetenv :: AsteriusModule posixGetenv = runEDSL "getenv" $ do - setReturnTypes [I64] - p <- param I64 - truncSFloat64ToInt64 - <$> callImport' + setReturnTypes [I32] + p <- param I32 + callImport' "__asterius_posix_getenv" - (map convertSInt64ToFloat64 [p, symbol "__asterius_posix_getenv_buf"]) - F64 - >>= emit - -posixAccess :: AsteriusModule -posixAccess = runEDSL "access" $ do - setReturnTypes [I64] - args <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_posix_access" - (map convertSInt64ToFloat64 args) - F64 - >>= emit - -posixGetcwd :: AsteriusModule -posixGetcwd = runEDSL "getcwd" $ do - setReturnTypes [I64] - args <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_posix_getcwd" - (map convertSInt64ToFloat64 args) - F64 + [p, symbol "__asterius_posix_getenv_buf"] + I32 >>= emit diff --git a/asterius/src/Asterius/Builtins/SM.hs b/asterius/src/Asterius/Builtins/SM.hs index bc21304f..85f2f67d 100644 --- a/asterius/src/Asterius/Builtins/SM.hs +++ b/asterius/src/Asterius/Builtins/SM.hs @@ -14,35 +14,33 @@ smCBits = growStack growStack :: AsteriusModule growStack = runEDSL "growStack" $ do - setReturnTypes [I64] - prev_stack_obj <- param I64 - prev_sp <- i64Local $ loadI64 prev_stack_obj offset_StgStack_sp + setReturnTypes [I32] + prev_stack_obj <- param I32 + prev_sp <- local I32 $ loadI32 prev_stack_obj offset_StgStack_sp prev_stack_obj_size <- - i64Local - $ addInt64 (constI64 offset_StgStack_stack) - $ mulInt64 (constI64 8) - $ extendUInt32 + local I32 + $ addInt32 (constI32 offset_StgStack_stack) + $ mulInt32 (constI32 4) $ loadI32 prev_stack_obj offset_StgStack_stack_size prev_stack_used <- - i64Local $ + local I32 $ prev_stack_obj_size - `subInt64` (prev_sp `subInt64` prev_stack_obj) - next_stack_obj_size <- i64Local $ prev_stack_obj_size `mulInt64` constI64 2 + `subInt32` (prev_sp `subInt32` prev_stack_obj) + next_stack_obj_size <- local I32 $ prev_stack_obj_size `mulInt32` constI32 2 next_stack_obj <- call' "allocatePinned" [mainCapability, next_stack_obj_size] - I64 + I32 next_sp <- - i64Local $ + local I32 $ next_stack_obj - `addInt64` next_stack_obj_size - `subInt64` prev_stack_used - emit $ memcpy next_stack_obj prev_stack_obj (constI64 offset_StgStack_stack) + `addInt32` next_stack_obj_size + `subInt32` prev_stack_used + emit $ memcpy next_stack_obj prev_stack_obj (constI32 offset_StgStack_stack) storeI32 next_stack_obj offset_StgStack_stack_size - $ wrapInt64 - $ (next_stack_obj_size `subInt64` constI64 offset_StgStack_stack) - `divUInt64` constI64 8 - storeI64 next_stack_obj offset_StgStack_sp next_sp + $ (next_stack_obj_size `subInt32` constI32 offset_StgStack_stack) + `divUInt32` constI32 4 + storeI32 next_stack_obj offset_StgStack_sp next_sp emit $ memcpy next_sp prev_sp prev_stack_used emit next_stack_obj diff --git a/asterius/src/Asterius/Builtins/Scheduler.hs b/asterius/src/Asterius/Builtins/Scheduler.hs index 2bc0cd7b..3e211419 100644 --- a/asterius/src/Asterius/Builtins/Scheduler.hs +++ b/asterius/src/Asterius/Builtins/Scheduler.hs @@ -3,31 +3,21 @@ module Asterius.Builtins.Scheduler ( schedulerImports, - schedulerCBits, ) where -import Asterius.EDSL import Asterius.Types schedulerImports :: [FunctionImport] schedulerImports = [ FunctionImport - { internalName = "__asterius_tsoReportException", + { internalName = "tsoReportException", externalModuleName = "Scheduler", externalBaseName = "tsoReportException", functionType = FunctionType - { paramTypes = [F64, F64], + { paramTypes = [I32, I32], returnTypes = [] } } ] - -schedulerCBits :: AsteriusModule -schedulerCBits = tsoReportException - -tsoReportException :: AsteriusModule -tsoReportException = runEDSL "tsoReportException" $ do - args <- params [I64, I64] - callImport "__asterius_tsoReportException" (map convertUInt64ToFloat64 args) diff --git a/asterius/src/Asterius/Builtins/Sparks.hs b/asterius/src/Asterius/Builtins/Sparks.hs index 3b5e3817..c4dcfe18 100644 --- a/asterius/src/Asterius/Builtins/Sparks.hs +++ b/asterius/src/Asterius/Builtins/Sparks.hs @@ -19,6 +19,6 @@ sparksCBits = newSpark -- https://github.com/tweag/asterius/issues/653). newSpark :: AsteriusModule newSpark = runEDSL "newSpark" $ do - setReturnTypes [I64] - _ <- params [I64, I64] - emit $ constI64 1 + setReturnTypes [I32] + _ <- params [I32, I32] + emit $ constI32 1 diff --git a/asterius/src/Asterius/Builtins/Time.hs b/asterius/src/Asterius/Builtins/Time.hs index 67f971f8..69bda79b 100644 --- a/asterius/src/Asterius/Builtins/Time.hs +++ b/asterius/src/Asterius/Builtins/Time.hs @@ -3,89 +3,53 @@ module Asterius.Builtins.Time ( timeImports, - timeCBits, ) where -import Asterius.EDSL import Asterius.Types timeImports :: [FunctionImport] timeImports = [ FunctionImport - { internalName = "__asterius_clock_getres", + { internalName = "clock_getres", externalModuleName = "time", externalBaseName = "clock_getres", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_clock_gettime", + { internalName = "ghczuwrapperZC0ZCbaseZCSystemziCPUTimeziPosixziClockGetTimeZCclockzugetres", + externalModuleName = "time", + externalBaseName = "clock_getres", + functionType = FunctionType + { paramTypes = [I32, I32], + returnTypes = [I32] + } + }, + FunctionImport + { internalName = "clock_gettime", externalModuleName = "time", externalBaseName = "clock_gettime", functionType = FunctionType - { paramTypes = [F64, F64], - returnTypes = [F64] + { paramTypes = [I32, I32], + returnTypes = [I32] } }, FunctionImport - { internalName = "__asterius_getMonotonicNSec", + { internalName = "ghczuwrapperZC0ZCbaseZCSystemziCPUTimeziPosixziClockGetTimeZCclockzugettime", + externalModuleName = "time", + externalBaseName = "clock_gettime", + functionType = FunctionType + { paramTypes = [I32, I32], + returnTypes = [I32] + } + }, + FunctionImport + { internalName = "getMonotonicNSec", externalModuleName = "time", externalBaseName = "getMonotonicNSec", - functionType = FunctionType {paramTypes = [], returnTypes = [F64]} + functionType = FunctionType {paramTypes = [], returnTypes = [I64]} } ] - -timeCBits :: AsteriusModule -timeCBits = - clockGetRes - <> clockGetTime - <> capiClockGetRes - <> capiClockGetTime - <> getMonotonicNSec - -clockGetRes, - clockGetTime, - capiClockGetRes, - capiClockGetTime, - getMonotonicNSec :: - AsteriusModule -clockGetRes = runEDSL "clock_getres" $ do - setReturnTypes [I64] - args <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_clock_getres" - (map convertUInt64ToFloat64 args) - F64 - >>= emit -clockGetTime = runEDSL "clock_gettime" $ do - setReturnTypes [I64] - args <- params [I64, I64] - truncSFloat64ToInt64 - <$> callImport' - "__asterius_clock_gettime" - (map convertUInt64ToFloat64 args) - F64 - >>= emit -capiClockGetRes = - runEDSL - "ghczuwrapperZC0ZCbaseZCSystemziCPUTimeziPosixziClockGetTimeZCclockzugetres" - $ do - setReturnTypes [I64] - args <- params [I64, I64] - call' "clock_getres" args I64 >>= emit -capiClockGetTime = - runEDSL - "ghczuwrapperZC0ZCbaseZCSystemziCPUTimeziPosixziClockGetTimeZCclockzugettime" - $ do - setReturnTypes [I64] - args <- params [I64, I64] - call' "clock_gettime" args I64 >>= emit -getMonotonicNSec = runEDSL "getMonotonicNSec" $ do - setReturnTypes [I64] - truncUFloat64ToInt64 - <$> callImport' "__asterius_getMonotonicNSec" [] F64 - >>= emit diff --git a/asterius/src/Asterius/CodeGen.hs b/asterius/src/Asterius/CodeGen.hs index e99ac19d..fc29efc2 100644 --- a/asterius/src/Asterius/CodeGen.hs +++ b/asterius/src/Asterius/CodeGen.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-overflowed-literals #-} @@ -17,10 +18,10 @@ module Asterius.CodeGen ) where -import Asterius.Builtins import Asterius.EDSL import Asterius.Internals import Asterius.Internals.Name +import Asterius.Internals.PrettyShow import Asterius.Passes.All import Asterius.Passes.GlobalRegs import Asterius.Resolve @@ -30,7 +31,7 @@ import Asterius.TypesConv import qualified CLabel as GHC import qualified Cmm as GHC import qualified CmmSwitch as GHC -import Control.Exception +import Control.Monad.Catch import Control.Monad.Except import Control.Monad.Reader import qualified Data.ByteString as BS @@ -54,23 +55,21 @@ import MonadUtils (mapAccumLM) import Stream (Stream) import qualified Stream import qualified Unique as GHC +import System.IO type CodeGenContext = (GHC.DynFlags, String) newtype CodeGen a = CodeGen (ReaderT CodeGenContext IO a) - deriving (Functor, Applicative, Monad, MonadReader CodeGenContext, MonadIO) - -unCodeGen :: CodeGen a -> CodeGen (Either AsteriusCodeGenError a) -unCodeGen (CodeGen m) = CodeGen (mapReaderT try m) + deriving (Functor, Applicative, Monad, MonadReader CodeGenContext, MonadIO, MonadThrow, MonadCatch) {-# INLINEABLE runCodeGen #-} runCodeGen :: CodeGen a -> GHC.DynFlags -> GHC.Module -> - IO (Either AsteriusCodeGenError a) -runCodeGen (unCodeGen -> CodeGen m) dflags def_mod = + IO a +runCodeGen (CodeGen m) dflags def_mod = runReaderT m (dflags, asmPpr dflags def_mod <> "_") marshalCLabel :: GHC.CLabel -> CodeGen EntitySymbol @@ -102,7 +101,7 @@ marshalCmmType t | GHC.f64 `GHC.cmmEqType_ignoring_ptrhood` t = pure F64 | otherwise = - liftIO $ throwIO $ UnsupportedCmmType $ showBS t + throwM $ UnsupportedCmmType $ showBS t dispatchCmmWidth :: GHC.Width -> a -> a -> CodeGen a dispatchCmmWidth w r32 = dispatchAllCmmWidth w r32 r32 r32 @@ -113,7 +112,7 @@ dispatchAllCmmWidth w r8 r16 r32 r64 = case w of GHC.W16 -> pure r16 GHC.W32 -> pure r32 GHC.W64 -> pure r64 - _ -> liftIO $ throwIO $ UnsupportedCmmWidth $ showBS w + _ -> throwM $ UnsupportedCmmWidth $ showBS w marshalForeignHint :: GHC.ForeignHint -> FFIHint marshalForeignHint GHC.NoHint = NoHint @@ -153,7 +152,7 @@ marshalCmmStatic st = case st of GHC.CmmLabelOff clbl o -> do sym <- marshalCLabel clbl pure $ SymbolStatic sym o - _ -> liftIO $ throwIO $ UnsupportedCmmLit $ showBS lit + _ -> throwM $ UnsupportedCmmLit $ showBS lit GHC.CmmUninitialised s -> pure $ Uninitialized s GHC.CmmString s -> pure $ Serialized $ s `BS.snoc` 0 @@ -187,7 +186,7 @@ marshalTypedCmmLocalReg :: GHC.LocalReg -> ValueType -> CodeGen UnresolvedLocalReg marshalTypedCmmLocalReg r vt = do (lr, vt') <- marshalCmmLocalReg r - if vt == vt' then pure lr else liftIO $ throwIO $ UnsupportedCmmExpr $ showBS r + if vt == vt' then pure lr else throwM $ UnsupportedCmmExpr $ showBS r marshalCmmGlobalReg :: GHC.GlobalReg -> CodeGen UnresolvedGlobalReg marshalCmmGlobalReg r = case r of @@ -207,7 +206,7 @@ marshalCmmGlobalReg r = case r of GHC.GCEnter1 -> pure GCEnter1 GHC.GCFun -> pure GCFun GHC.BaseReg -> pure BaseReg - _ -> liftIO $ throwIO $ UnsupportedCmmGlobalReg $ showBS r + _ -> throwM $ UnsupportedCmmGlobalReg $ showBS r marshalCmmLit :: GHC.CmmLit -> CodeGen (Expression, ValueType) marshalCmmLit lit = case lit of @@ -223,15 +222,15 @@ marshalCmmLit lit = case lit of (ConstF64 $ fromRational x, F64) GHC.CmmLabel clbl -> do sym <- marshalCLabel clbl - pure (Symbol {unresolvedSymbol = sym, symbolOffset = 0}, I64) + pure (Symbol {unresolvedSymbol = sym, symbolOffset = 0}, I32) GHC.CmmLabelOff clbl o -> do sym <- marshalCLabel clbl - pure (Symbol {unresolvedSymbol = sym, symbolOffset = o}, I64) - _ -> liftIO $ throwIO $ UnsupportedCmmLit $ showBS lit + pure (Symbol {unresolvedSymbol = sym, symbolOffset = o}, I32) + _ -> throwM $ UnsupportedCmmLit $ showBS lit marshalCmmLoad :: GHC.CmmExpr -> GHC.CmmType -> CodeGen (Expression, ValueType) marshalCmmLoad p t = do - pv <- marshalAndCastCmmExpr p I32 + pv <- marshalAndCheckCmmExpr p I32 join $ dispatchAllCmmWidth (GHC.typeWidth t) @@ -315,7 +314,7 @@ marshalCmmRegOff r o = do }, vt ) - _ -> liftIO $ throwIO $ UnsupportedCmmExpr $ showBS $ GHC.CmmRegOff r o + _ -> throwM $ UnsupportedCmmExpr $ showBS $ GHC.CmmRegOff r o marshalCmmBinMachOp :: BinaryOp -> @@ -335,56 +334,16 @@ marshalCmmBinMachOp o32 tx32 ty32 tr32 o64 tx64 ty64 tr64 w x y = dispatchCmmWidth w ( do - xe <- marshalAndCastCmmExpr x tx32 - ye <- marshalAndCastCmmExpr y ty32 + xe <- marshalAndCheckCmmExpr x tx32 + ye <- marshalAndCheckCmmExpr y ty32 pure (Binary {binaryOp = o32, operand0 = xe, operand1 = ye}, tr32) ) ( do - xe <- marshalAndCastCmmExpr x tx64 - ye <- marshalAndCastCmmExpr y ty64 + xe <- marshalAndCheckCmmExpr x tx64 + ye <- marshalAndCheckCmmExpr y ty64 pure (Binary {binaryOp = o64, operand0 = xe, operand1 = ye}, tr64) ) --- Should this logic be pushed into `marshalAndCastCmmExpr? -marshalCmmHomoConvMachOp :: - UnaryOp -> - UnaryOp -> - ValueType -> - ValueType -> - GHC.Width -> - GHC.Width -> - ShouldSext -> - GHC.CmmExpr -> - CodeGen (Expression, ValueType) -marshalCmmHomoConvMachOp o36 o63 t32 t64 w0 w1 sext x - | (w0 == GHC.W8 || w0 == GHC.W16) && (w1 == GHC.W32 || w1 == GHC.W64) = - -- we are extending from {W8, W16} to {W32, W64}. Sign extension - -- semantics matters here. - do - (xe, _) <- marshalCmmExpr x - pure - ( genExtend - (if w0 == GHC.W8 then 1 else 2) - (if w1 == GHC.W32 then I32 else I64) - sext - xe, - if w1 == GHC.W64 then I64 else I32 - ) - | (w0 == GHC.W32 || w0 == GHC.W64) && (w1 == GHC.W8 || w1 == GHC.W16) = - -- we are wrapping from {32, 64} to {8, 16} - do - (xe, _) <- marshalCmmExpr x - pure - ( genWrap (if w0 == GHC.W32 then I32 else I64) (GHC.widthInBytes w1) xe, - I32 - ) - | otherwise = - -- we are converting from {32, 64} to {32, 64} of floating point / int - do - (o, t, tr) <- dispatchCmmWidth w1 (o63, t64, t32) (o36, t32, t64) - xe <- marshalAndCastCmmExpr x t - pure (Unary {unaryOp = o, operand0 = xe}, tr) - marshalCmmHeteroConvMachOp :: UnaryOp -> UnaryOp -> @@ -405,7 +364,7 @@ marshalCmmHeteroConvMachOp o33 o36 o63 o66 tx32 ty32 tx64 ty64 w0 w1 x = do ((o33, tx32, ty32), (o36, tx32, ty64)) ((o63, tx64, ty32), (o66, tx64, ty64)) (o, t, tr) <- dispatchCmmWidth w1 g0 g1 - xe <- marshalAndCastCmmExpr x t + xe <- marshalAndCheckCmmExpr x t pure (Unary {unaryOp = o, operand0 = xe}, tr) marshalCmmMachOp :: @@ -431,14 +390,14 @@ marshalCmmMachOp (GHC.MO_S_Neg w) [x] = dispatchCmmWidth w ( do - xe <- marshalAndCastCmmExpr x I32 + xe <- marshalAndCheckCmmExpr x I32 pure ( Binary {binaryOp = SubInt32, operand0 = ConstI32 0, operand1 = xe}, I32 ) ) ( do - xe <- marshalAndCastCmmExpr x I64 + xe <- marshalAndCheckCmmExpr x I64 pure ( Binary {binaryOp = SubInt64, operand0 = ConstI64 0, operand1 = xe}, I64 @@ -477,11 +436,11 @@ marshalCmmMachOp (GHC.MO_F_Neg w) [x] = dispatchCmmWidth w ( do - xe <- marshalAndCastCmmExpr x F32 + xe <- marshalAndCheckCmmExpr x F32 pure (Unary {unaryOp = NegFloat32, operand0 = xe}, F32) ) ( do - xe <- marshalAndCastCmmExpr x F64 + xe <- marshalAndCheckCmmExpr x F64 pure (Unary {unaryOp = NegFloat64, operand0 = xe}, F64) ) marshalCmmMachOp (GHC.MO_F_Mul w) [x, y] = @@ -514,7 +473,7 @@ marshalCmmMachOp (GHC.MO_Not w) [x] = dispatchCmmWidth w ( do - xe <- marshalAndCastCmmExpr x I32 + xe <- marshalAndCheckCmmExpr x I32 pure ( Binary { binaryOp = XorInt32, @@ -525,7 +484,7 @@ marshalCmmMachOp (GHC.MO_Not w) [x] = ) ) ( do - xe <- marshalAndCastCmmExpr x I64 + xe <- marshalAndCheckCmmExpr x I64 pure ( Binary { binaryOp = XorInt64, @@ -569,12 +528,60 @@ marshalCmmMachOp (GHC.MO_FS_Conv w0 w1) [x] = w0 w1 x -marshalCmmMachOp (GHC.MO_SS_Conv w0 w1) [x] = - marshalCmmHomoConvMachOp ExtendSInt32 WrapInt64 I32 I64 w0 w1 Sext x -marshalCmmMachOp (GHC.MO_UU_Conv w0 w1) [x] = - marshalCmmHomoConvMachOp ExtendUInt32 WrapInt64 I32 I64 w0 w1 NoSext x -marshalCmmMachOp (GHC.MO_FF_Conv w0 w1) [x] = - marshalCmmHomoConvMachOp PromoteFloat32 DemoteFloat64 F32 F64 w0 w1 Sext x +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W8 GHC.W16) [x] = marshalCmmExpr x +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W8 GHC.W32) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (Unary { unaryOp = ExtendS8Int32, operand0 = xe }, I32) +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W8 GHC.W64) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (Unary { unaryOp = ExtendS8Int64, operand0 = xe }, I64) +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W16 GHC.W8) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure ((xe `shlInt32` constI32 24) `shrSInt32` constI32 24, I32) +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W16 GHC.W32) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (Unary { unaryOp = ExtendS16Int32, operand0 = xe }, I32) +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W16 GHC.W64) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (Unary { unaryOp = ExtendS16Int64, operand0 = xe }, I64) +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W32 GHC.W8) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure ((xe `shlInt32` constI32 24) `shrSInt32` constI32 24, I32) +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W32 GHC.W16) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure ((xe `shlInt32` constI32 16) `shrSInt32` constI32 16, I32) +marshalCmmMachOp (GHC.MO_SS_Conv GHC.W32 GHC.W64) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (Unary { unaryOp = ExtendS32Int64, operand0 = xe }, I64) +marshalCmmMachOp (GHC.MO_SS_Conv w0 w1) [x] | w0 == w1 = marshalCmmExpr x +marshalCmmMachOp (GHC.MO_UU_Conv GHC.W8 GHC.W32) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (xe `andInt32` constI32 0xFF, I32) +marshalCmmMachOp (GHC.MO_UU_Conv GHC.W16 GHC.W32) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (xe `andInt32` constI32 0xFFFF, I32) +marshalCmmMachOp (GHC.MO_UU_Conv _ GHC.W64) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (Unary { unaryOp = ExtendUInt32, operand0 = xe }, I64) +marshalCmmMachOp (GHC.MO_UU_Conv GHC.W64 GHC.W32) [x] = do + xe <- marshalAndCheckCmmExpr x I64 + pure (Unary { unaryOp = WrapInt64, operand0 = xe }, I32) +marshalCmmMachOp (GHC.MO_UU_Conv GHC.W32 GHC.W8) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (xe `andInt32` constI32 0xFF, I32) +marshalCmmMachOp (GHC.MO_UU_Conv GHC.W32 GHC.W16) [x] = do + xe <- marshalAndCheckCmmExpr x I32 + pure (xe `andInt32` constI32 0xFFFF, I32) +marshalCmmMachOp (GHC.MO_UU_Conv w0 w1) [x] | w0 == w1 = marshalCmmExpr x +marshalCmmMachOp (GHC.MO_XX_Conv w0 w1) [x] = marshalCmmMachOp (GHC.MO_UU_Conv w0 w1) [x] +marshalCmmMachOp (GHC.MO_FF_Conv GHC.W32 GHC.W64) [x] = do + xe <- marshalAndCheckCmmExpr x F32 + pure (promoteFloat32 xe, F64) +marshalCmmMachOp (GHC.MO_FF_Conv GHC.W64 GHC.W32) [x] = do + xe <- marshalAndCheckCmmExpr x F64 + pure (demoteFloat64 xe, F32) +--marshalCmmMachOp (GHC.MO_FF_Conv w0 w1) [x] = +-- marshalCmmHomoConvMachOp PromoteFloat32 DemoteFloat64 F32 F64 w0 w1 Sext x -- Unhandled cases -- -- Signed multiply/divide -- MO_S_MulMayOflo Width -- nonzero if signed multiply overflows @@ -606,7 +613,7 @@ marshalCmmMachOp (GHC.MO_FF_Conv w0 w1) [x] = -- -- Alignment check (for -falignment-sanitisation) -- MO_AlignmentCheck Int Width marshalCmmMachOp op xs = - liftIO $ throwIO $ UnsupportedCmmExpr $ showBS $ GHC.CmmMachOp op xs + throwM $ UnsupportedTodo $ show op marshalCmmExpr :: GHC.CmmExpr -> CodeGen (Expression, ValueType) marshalCmmExpr cmm_expr = case cmm_expr of @@ -615,22 +622,14 @@ marshalCmmExpr cmm_expr = case cmm_expr of GHC.CmmReg r -> marshalCmmReg r GHC.CmmMachOp op xs -> marshalCmmMachOp op xs GHC.CmmRegOff r o -> marshalCmmRegOff r o - _ -> liftIO $ throwIO $ UnsupportedCmmExpr $ showBS cmm_expr + _ -> throwM $ UnsupportedCmmExpr $ showBS cmm_expr -marshalAndCastCmmExpr :: GHC.CmmExpr -> ValueType -> CodeGen Expression -marshalAndCastCmmExpr cmm_expr dest_vt = do +marshalAndCheckCmmExpr :: GHC.CmmExpr -> ValueType -> CodeGen Expression +marshalAndCheckCmmExpr cmm_expr dest_vt = do (src_expr, src_vt) <- marshalCmmExpr cmm_expr - case (# src_vt, dest_vt #) of - (# I32, I64 #) -> - pure Unary {unaryOp = ExtendSInt32, operand0 = src_expr} - (# I64, I32 #) -> pure Unary {unaryOp = WrapInt64, operand0 = src_expr} - (# I64, F64 #) -> - pure Unary {unaryOp = ConvertSInt64ToFloat64, operand0 = src_expr} - _ - | src_vt == dest_vt -> pure src_expr - | otherwise -> - liftIO $ throwIO $ - UnsupportedImplicitCasting src_expr src_vt dest_vt + if src_vt == dest_vt then pure src_expr + else throwM $ + UnsupportedImplicitCasting src_expr src_vt dest_vt marshalCmmUnPrimCall :: ValueType -> -- result type @@ -641,7 +640,7 @@ marshalCmmUnPrimCall :: CodeGen [Expression] marshalCmmUnPrimCall retTyp ret vTyp v op = do lr <- marshalTypedCmmLocalReg ret retTyp - xe <- marshalAndCastCmmExpr v vTyp + xe <- marshalAndCheckCmmExpr v vTyp pure [UnresolvedSetLocal {unresolvedLocalReg = lr, value = op xe}] marshalCmmQuotRemPrimCall :: @@ -658,8 +657,8 @@ marshalCmmQuotRemPrimCall :: marshalCmmQuotRemPrimCall tmp0 tmp1 qop rop vt qr rr x y = do qlr <- marshalTypedCmmLocalReg qr vt rlr <- marshalTypedCmmLocalReg rr vt - xe <- marshalAndCastCmmExpr x vt - ye <- marshalAndCastCmmExpr y vt + xe <- marshalAndCheckCmmExpr x vt + ye <- marshalAndCheckCmmExpr y vt pure [ UnresolvedSetLocal {unresolvedLocalReg = tmp0, value = xe}, UnresolvedSetLocal {unresolvedLocalReg = tmp1, value = ye}, @@ -689,7 +688,7 @@ marshalCmmUnMathPrimCall :: CodeGen [Expression] marshalCmmUnMathPrimCall op vt r x = do lr <- marshalTypedCmmLocalReg r vt - xe <- marshalAndCastCmmExpr x vt + xe <- marshalAndCheckCmmExpr x vt pure [ UnresolvedSetLocal { unresolvedLocalReg = lr, @@ -715,8 +714,8 @@ marshalCmmBinMathPrimCall :: CodeGen [Expression] marshalCmmBinMathPrimCall op vt r x y = do lr <- marshalTypedCmmLocalReg r vt - xe <- marshalAndCastCmmExpr x vt - ye <- marshalAndCastCmmExpr y vt + xe <- marshalAndCheckCmmExpr x vt + ye <- marshalAndCheckCmmExpr y vt pure [ UnresolvedSetLocal { unresolvedLocalReg = lr, @@ -816,7 +815,7 @@ marshalCmmPrimCall (GHC.MO_UF_Conv w) [r] [x] = do (ConvertUInt64ToFloat32, F32) (ConvertUInt64ToFloat64, F64) lr <- marshalTypedCmmLocalReg r ft - xe <- marshalAndCastCmmExpr x I64 + xe <- marshalAndCheckCmmExpr x I32 pure [ UnresolvedSetLocal { unresolvedLocalReg = lr, @@ -879,25 +878,25 @@ marshalCmmPrimCall GHC.MO_WriteBarrier _ _ = pure [] marshalCmmPrimCall GHC.MO_Touch _ _ = pure [] marshalCmmPrimCall (GHC.MO_Prefetch_Data _) _ _ = pure [] marshalCmmPrimCall (GHC.MO_Memcpy _) [] [_dst, _src, _n] = do - dst <- marshalAndCastCmmExpr _dst I64 - src <- marshalAndCastCmmExpr _src I64 - n <- marshalAndCastCmmExpr _n I64 + dst <- marshalAndCheckCmmExpr _dst I32 + src <- marshalAndCheckCmmExpr _src I32 + n <- marshalAndCheckCmmExpr _n I32 pure [memcpy dst src n] marshalCmmPrimCall (GHC.MO_Memset _) [] [_dst, _c, _n] = do - dst <- marshalAndCastCmmExpr _dst I64 - c <- marshalAndCastCmmExpr _c I64 - n <- marshalAndCastCmmExpr _n I64 + dst <- marshalAndCheckCmmExpr _dst I32 + c <- marshalAndCheckCmmExpr _c I32 + n <- marshalAndCheckCmmExpr _n I32 pure [memset dst c n] marshalCmmPrimCall (GHC.MO_Memmove _) [] [_dst, _src, _n] = do - dst <- marshalAndCastCmmExpr _dst I64 - src <- marshalAndCastCmmExpr _src I64 - n <- marshalAndCastCmmExpr _n I64 + dst <- marshalAndCheckCmmExpr _dst I32 + src <- marshalAndCheckCmmExpr _src I32 + n <- marshalAndCheckCmmExpr _n I32 pure [memmove dst src n] marshalCmmPrimCall (GHC.MO_Memcmp _) [_cres] [_ptr1, _ptr2, _n] = do cres <- marshalTypedCmmLocalReg _cres I32 - ptr1 <- marshalAndCastCmmExpr _ptr1 I64 - ptr2 <- marshalAndCastCmmExpr _ptr2 I64 - n <- marshalAndCastCmmExpr _n I64 + ptr1 <- marshalAndCheckCmmExpr _ptr1 I32 + ptr2 <- marshalAndCheckCmmExpr _ptr2 I32 + n <- marshalAndCheckCmmExpr _n I32 pure [ UnresolvedSetLocal { unresolvedLocalReg = cres, @@ -905,69 +904,67 @@ marshalCmmPrimCall (GHC.MO_Memcmp _) [_cres] [_ptr1, _ptr2, _n] = do } ] marshalCmmPrimCall (GHC.MO_PopCnt GHC.W64) [r] [x] = - marshalCmmUnPrimCall I64 r I64 x popcntInt64 + marshalCmmUnPrimCall I32 r I64 x (wrapInt64. popcntInt64) marshalCmmPrimCall (GHC.MO_PopCnt GHC.W32) [r] [x] = do - marshalCmmUnPrimCall I64 r I32 x (extendSInt32 . popcntInt32) + marshalCmmUnPrimCall I32 r I32 x popcntInt32 marshalCmmPrimCall (GHC.MO_PopCnt GHC.W16) [r] [x] = do marshalCmmUnPrimCall - I64 + I32 r I32 x - (extendSInt32 . popcntInt32 . andInt32 (constI32 0xFFFF)) + (popcntInt32 . andInt32 (constI32 0xFFFF)) marshalCmmPrimCall (GHC.MO_PopCnt GHC.W8) [r] [x] = do marshalCmmUnPrimCall - I64 + I32 r I32 x - (extendSInt32 . popcntInt32 . andInt32 (constI32 0xFF)) + (popcntInt32 . andInt32 (constI32 0xFF)) -- Unhandled: MO_Pdep Width -- Unhandled: MO_Pext Width marshalCmmPrimCall (GHC.MO_Clz GHC.W64) [r] [x] = - marshalCmmUnPrimCall I64 r I64 x clzInt64 + marshalCmmUnPrimCall I32 r I64 x (wrapInt64. clzInt64) marshalCmmPrimCall (GHC.MO_Clz GHC.W32) [r] [x] = - marshalCmmUnPrimCall I64 r I32 x (extendSInt32 . clzInt32) + marshalCmmUnPrimCall I32 r I32 x clzInt32 marshalCmmPrimCall (GHC.MO_Clz GHC.W16) [r] [x] = marshalCmmUnPrimCall - I64 + I32 r I32 x - ( extendSInt32 - . clzInt32 + ( clzInt32 . orInt32 (constI32 0x8000) . (`shlInt32` constI32 16) ) marshalCmmPrimCall (GHC.MO_Clz GHC.W8) [r] [x] = marshalCmmUnPrimCall - I64 + I32 r I32 x - ( extendSInt32 - . clzInt32 + ( clzInt32 . orInt32 (constI32 0x800000) . (`shlInt32` constI32 24) ) marshalCmmPrimCall (GHC.MO_Ctz GHC.W64) [r] [x] = - marshalCmmUnPrimCall I64 r I64 x ctzInt64 + marshalCmmUnPrimCall I32 r I64 x (wrapInt64 . ctzInt64) marshalCmmPrimCall (GHC.MO_Ctz GHC.W32) [r] [x] = - marshalCmmUnPrimCall I64 r I32 x (extendSInt32 . ctzInt32) + marshalCmmUnPrimCall I32 r I32 x ctzInt32 marshalCmmPrimCall (GHC.MO_Ctz GHC.W16) [r] [x] = marshalCmmUnPrimCall - I64 + I32 r I32 x - (extendSInt32 . ctzInt32 . orInt32 (constI32 0x10000)) + (ctzInt32 . orInt32 (constI32 0x10000)) marshalCmmPrimCall (GHC.MO_Ctz GHC.W8) [r] [x] = marshalCmmUnPrimCall - I64 + I32 r I32 x - (extendSInt32 . ctzInt32 . orInt32 (constI32 0x100)) + (ctzInt32 . orInt32 (constI32 0x100)) -- r = result, o = overflow -- see also: GHC.Prim.subWordC# marshalCmmPrimCall (GHC.MO_SubWordC GHC.W64) [r, o] [x, y] = do @@ -1248,8 +1245,8 @@ marshalCmmPrimCall (GHC.MO_U_QuotRem2 GHC.W64) [q, r] [lhsHi, lhsLo, rhs] = do pure [quotout, remout] -- Unhandled: MO_BSwap W8 marshalCmmPrimCall (GHC.MO_BSwap GHC.W16) [r] [x] = do - lr <- marshalTypedCmmLocalReg r I64 - xe <- marshalAndCastCmmExpr x I64 + lr <- marshalTypedCmmLocalReg r I32 + xe <- marshalAndCheckCmmExpr x I32 pure [ UnresolvedSetLocal { unresolvedLocalReg = lr, @@ -1257,14 +1254,14 @@ marshalCmmPrimCall (GHC.MO_BSwap GHC.W16) [r] [x] = do Call { target = "hs_bswap16", operands = [xe], - callReturnTypes = [I64], + callReturnTypes = [I32], callHint = Just ([NoHint], [NoHint]) } } ] marshalCmmPrimCall (GHC.MO_BSwap GHC.W32) [r] [x] = do - lr <- marshalTypedCmmLocalReg r I64 - xe <- marshalAndCastCmmExpr x I64 + lr <- marshalTypedCmmLocalReg r I32 + xe <- marshalAndCheckCmmExpr x I32 pure [ UnresolvedSetLocal { unresolvedLocalReg = lr, @@ -1272,14 +1269,14 @@ marshalCmmPrimCall (GHC.MO_BSwap GHC.W32) [r] [x] = do Call { target = "hs_bswap32", operands = [xe], - callReturnTypes = [I64], + callReturnTypes = [I32], callHint = Just ([NoHint], [NoHint]) } } ] marshalCmmPrimCall (GHC.MO_BSwap GHC.W64) [r] [x] = do lr <- marshalTypedCmmLocalReg r I64 - xe <- marshalAndCastCmmExpr x I64 + xe <- marshalAndCheckCmmExpr x I64 pure [ UnresolvedSetLocal { unresolvedLocalReg = lr, @@ -1293,10 +1290,10 @@ marshalCmmPrimCall (GHC.MO_BSwap GHC.W64) [r] [x] = do } ] -- Atomic operations -marshalCmmPrimCall (GHC.MO_AtomicRMW GHC.W64 amop) [dst] [addr, n] = +marshalCmmPrimCall (GHC.MO_AtomicRMW GHC.W32 amop) [dst] [addr, n] = marshalCmmAtomicMachOpPrimCall amop dst addr n -marshalCmmPrimCall (GHC.MO_AtomicRead GHC.W64) [dst] [addr] = do - dstr <- marshalTypedCmmLocalReg dst I64 +marshalCmmPrimCall (GHC.MO_AtomicRead GHC.W32) [dst] [addr] = do + dstr <- marshalTypedCmmLocalReg dst I32 addrr <- fst <$> marshalCmmExpr addr pure [ UnresolvedSetLocal @@ -1304,26 +1301,26 @@ marshalCmmPrimCall (GHC.MO_AtomicRead GHC.W64) [dst] [addr] = do value = Load { signed = False, - bytes = 8, + bytes = 4, offset = 0, - valueType = I64, - ptr = wrapInt64 addrr + valueType = I32, + ptr = addrr } } ] -marshalCmmPrimCall (GHC.MO_AtomicWrite GHC.W64) [] [addr, val] = do +marshalCmmPrimCall (GHC.MO_AtomicWrite GHC.W32) [] [addr, val] = do addrr <- fst <$> marshalCmmExpr addr valr <- fst <$> marshalCmmExpr val pure [ Store - { bytes = 8, + { bytes = 4, offset = 0, - ptr = wrapInt64 addrr, + ptr = addrr, value = valr, - valueType = I64 + valueType = I32 } ] -marshalCmmPrimCall (GHC.MO_Cmpxchg GHC.W64) [dst] [addr, oldv, newv] = do +marshalCmmPrimCall (GHC.MO_Cmpxchg GHC.W32) [dst] [addr, oldv, newv] = do -- Copied from GHC.Prim: -- -- Given an array, an offset in Int units, the expected old value, and @@ -1331,7 +1328,7 @@ marshalCmmPrimCall (GHC.MO_Cmpxchg GHC.W64) [dst] [addr, oldv, newv] = do -- value if the current value matches the provided old value. Returns -- the value of the element before the operation. Implies a full memory -- barrier. - dstr <- marshalTypedCmmLocalReg dst I64 + dstr <- marshalTypedCmmLocalReg dst I32 addrr <- fst <$> marshalCmmExpr addr oldr <- fst <$> marshalCmmExpr oldv newr <- fst <$> marshalCmmExpr newv @@ -1341,33 +1338,29 @@ marshalCmmPrimCall (GHC.MO_Cmpxchg GHC.W64) [dst] [addr, oldv, newv] = do value = Load { signed = False, -- in Cmm everything is unsigned - bytes = 8, + bytes = 4, offset = 0, -- StgCmmPrim.doAtomicRMW has done the work - valueType = I64, - ptr = wrapInt64 addrr + valueType = I32, + ptr = addrr } } let expr2 = If - { condition = UnresolvedGetLocal dstr `eqInt64` oldr, + { condition = UnresolvedGetLocal dstr `eqInt32` oldr, ifTrue = Store - { bytes = 8, + { bytes = 4, offset = 0, - ptr = wrapInt64 addrr, + ptr = addrr, value = newr, - valueType = I64 + valueType = I32 }, ifFalse = Nothing } pure [expr1, expr2] -- Uncovered cases marshalCmmPrimCall op rs xs = - liftIO $ throwIO $ UnsupportedCmmInstr $ showBS $ - GHC.CmmUnsafeForeignCall - (GHC.PrimTarget op) - rs - xs + throwM $ UnsupportedTodo $ show op -- | Marshal an atomic MachOp. marshalCmmAtomicMachOpPrimCall :: @@ -1377,39 +1370,39 @@ marshalCmmAtomicMachOpPrimCall :: GHC.LocalReg -> -- | The address GHC.CmmExpr -> - -- | The second operand (I64) + -- | The second operand (I32) GHC.CmmExpr -> CodeGen [Expression] marshalCmmAtomicMachOpPrimCall machop dst addr n = do - dstr <- marshalTypedCmmLocalReg dst I64 + dstr <- marshalTypedCmmLocalReg dst I32 addrr <- fst <$> marshalCmmExpr addr nr <- fst <$> marshalCmmExpr n let fn = case machop of - GHC.AMO_Add -> addInt64 - GHC.AMO_Sub -> subInt64 - GHC.AMO_And -> andInt64 - GHC.AMO_Nand -> nandInt64 - GHC.AMO_Or -> orInt64 - GHC.AMO_Xor -> xorInt64 + GHC.AMO_Add -> addInt32 + GHC.AMO_Sub -> subInt32 + GHC.AMO_And -> andInt32 + GHC.AMO_Nand -> \e1 e2 -> xorInt32 (constI32 0xFFFFFFFF) $ andInt32 e1 e2 + GHC.AMO_Or -> orInt32 + GHC.AMO_Xor -> xorInt32 let expr1 = UnresolvedSetLocal { unresolvedLocalReg = dstr, value = Load { signed = False, -- in Cmm everything is unsigned - bytes = 8, + bytes = 4, offset = 0, -- StgCmmPrim.doAtomicRMW has done the work - valueType = I64, - ptr = wrapInt64 addrr + valueType = I32, + ptr = addrr } } let expr2 = Store - { bytes = 8, + { bytes = 4, offset = 0, - ptr = wrapInt64 addrr, + ptr = addrr, value = fn (UnresolvedGetLocal dstr) nr, - valueType = I64 + valueType = I32 } pure [expr1, expr2] @@ -1444,13 +1437,13 @@ marshalCmmUnsafeCall p@(GHC.CmmLit (GHC.CmmLabel clbl)) f@(GHC.ForeignConvention } ] _ -> - liftIO $ throwIO $ UnsupportedCmmInstr $ showBS $ + throwM $ UnsupportedCmmInstr $ showBS $ GHC.CmmUnsafeForeignCall (GHC.ForeignTarget p f) rs xs marshalCmmUnsafeCall p f rs xs = do - fp <- marshalAndCastCmmExpr p I32 + fp <- marshalAndCheckCmmExpr p I32 (xes, xts) <- unzip <$> for xs marshalCmmExpr case rs of [] -> @@ -1479,7 +1472,7 @@ marshalCmmUnsafeCall p f rs xs = do } ] _ -> - liftIO $ throwIO $ UnsupportedCmmInstr $ showBS $ + throwM $ UnsupportedCmmInstr $ showBS $ GHC.CmmUnsafeForeignCall (GHC.ForeignTarget p f) rs @@ -1495,21 +1488,21 @@ marshalCmmInstr instr = case instr of marshalCmmUnsafeCall t c rs xs GHC.CmmAssign (GHC.CmmLocal r) e -> do (lr, vt) <- marshalCmmLocalReg r - v <- marshalAndCastCmmExpr e vt + v <- marshalAndCheckCmmExpr e vt pure [UnresolvedSetLocal {unresolvedLocalReg = lr, value = v}] GHC.CmmAssign (GHC.CmmGlobal r) e -> do gr <- marshalCmmGlobalReg r - v <- marshalAndCastCmmExpr e $ unresolvedGlobalRegType gr + v <- marshalAndCheckCmmExpr e $ unresolvedGlobalRegType gr pure [unresolvedSetGlobal gr v] GHC.CmmStore p e -> do - pv <- marshalAndCastCmmExpr p I32 + pv <- marshalAndCheckCmmExpr p I32 (dflags, _) <- ask store_instr <- join $ dispatchAllCmmWidth (GHC.cmmExprWidth dflags e) ( do - xe <- marshalAndCastCmmExpr e I32 + xe <- marshalAndCheckCmmExpr e I32 pure Store { bytes = 1, offset = 0, @@ -1519,7 +1512,7 @@ marshalCmmInstr instr = case instr of } ) ( do - xe <- marshalAndCastCmmExpr e I32 + xe <- marshalAndCheckCmmExpr e I32 pure Store { bytes = 2, offset = 0, @@ -1549,7 +1542,7 @@ marshalCmmInstr instr = case instr of } ) pure [store_instr] - _ -> liftIO $ throwIO $ UnsupportedCmmInstr $ showBS instr + _ -> throwM $ UnsupportedCmmInstr $ showBS instr marshalCmmBlockBody :: [GHC.CmmNode GHC.O GHC.O] -> CodeGen [Expression] marshalCmmBlockBody instrs = concat <$> for instrs marshalCmmInstr @@ -1571,7 +1564,7 @@ marshalCmmBlockBranch instr = case instr of NeedsUnreachableBlock False ) GHC.CmmCondBranch {..} -> do - c <- marshalAndCastCmmExpr cml_pred I32 + c <- marshalAndCheckCmmExpr cml_pred I32 kf <- marshalLabel cml_false kt <- marshalLabel cml_true pure @@ -1582,7 +1575,7 @@ marshalCmmBlockBranch instr = case instr of NeedsUnreachableBlock False ) GHC.CmmSwitch cml_arg st -> do - a <- marshalAndCastCmmExpr cml_arg I64 + a <- marshalAndCheckCmmExpr cml_arg I32 brs <- for (GHC.switchTargetsCases st) $ \(idx, lbl) -> do dest <- marshalLabel lbl pure (dest, [fromIntegral $ idx - fst (GHC.switchTargetsRange st)]) @@ -1593,16 +1586,13 @@ marshalCmmBlockBranch instr = case instr of Nothing -> pure (NeedsUnreachableBlock True, "__asterius_unreachable") pure ( [], - Just Unary - { unaryOp = WrapInt64, - operand0 = case GHC.switchTargetsRange st of + Just $ case GHC.switchTargetsRange st of (0, _) -> a (l, _) -> Binary - { binaryOp = SubInt64, + { binaryOp = SubInt32, operand0 = a, - operand1 = ConstI64 $ fromIntegral l - } - }, + operand1 = ConstI32 $ fromIntegral l + }, [ AddBranchForSwitch {to = dest, indexes = tags} | (dest, tags) <- M.toList $ M.fromListWith (<>) brs, dest /= dest_def @@ -1611,17 +1601,17 @@ marshalCmmBlockBranch instr = case instr of needs_unreachable ) GHC.CmmCall {..} -> do - t <- marshalAndCastCmmExpr cml_target I64 + t <- marshalAndCheckCmmExpr cml_target I32 pure ( [ case t of - Symbol {..} -> ReturnCall {returnCallTarget64 = unresolvedSymbol} - _ -> ReturnCallIndirect {returnCallIndirectTarget64 = t} + Symbol {..} -> ReturnCall {returnCallTarget = unresolvedSymbol} + _ -> ReturnCallIndirect {returnCallIndirectTarget = t} ], Nothing, [], NeedsUnreachableBlock False ) - _ -> liftIO $ throwIO $ UnsupportedCmmBranch $ showBS instr + _ -> throwM $ UnsupportedCmmBranch $ showBS instr marshalCmmBlock :: [GHC.CmmNode GHC.O GHC.O] -> @@ -1654,10 +1644,7 @@ marshalCmmBlock inner_nodes exit_node = do needs_unreachable ) where - concatExpressions es = case es of - [] -> Nop - [e] -> e - _ -> Block {name = "", bodys = es, blockReturnTypes = []} + concatExpressions es = Block {name = "", bodys = es, blockReturnTypes = []} marshalCmmProc :: GHC.CmmGraph -> CodeGen Function marshalCmmProc GHC.CmmGraph {g_graph = GHC.GMany _ body _, ..} = do @@ -1692,24 +1679,21 @@ marshalCmmDecl :: marshalCmmDecl decl = case decl of GHC.CmmData sec d@(GHC.Statics clbl _) -> do sym <- marshalCLabel clbl - r <- unCodeGen $ marshalCmmData sym sec d - pure $ case r of - Left err -> error $ "marshalCmmDecl: " <> show err - Right ass -> mempty {staticsMap = SM.fromList [(sym, ass)]} + r <- marshalCmmData sym sec d + pure $ mempty {staticsMap = SM.fromList [(sym, r)]} GHC.CmmProc _ clbl _ g -> do sym <- marshalCLabel clbl - r <- unCodeGen $ marshalCmmProc g - let f = case r of - Left err -> Function - { functionType = FunctionType {paramTypes = [], returnTypes = []}, - varTypes = [], - body = Barf - { barfMessage = fromString $ show err, - barfReturnTypes = [] - } - } - Right f' -> f' - pure $ mempty {functionMap = SM.singleton sym f} + catch (do + r <- marshalCmmProc g + pure $ mempty {functionMap = SM.singleton sym r}) + (\(err :: AsteriusCodeGenError) -> case err of + UnsupportedTodo err -> do + liftIO $ hPutStrLn stderr $ "[DEBUG]" <> show sym <> " " <> err + pure mempty + _ -> do + cmm_str <- liftIO $ prettyShow g + error $ cmm_str <> "\n" <> show err) + marshalHaskellIR :: GHC.Module -> [GHC.SptEntry] -> CmmIR -> CodeGen AsteriusModule marshalHaskellIR this_mod spt_entries CmmIR {..} = do diff --git a/asterius/src/Asterius/EDSL.hs b/asterius/src/Asterius/EDSL.hs index 523fbb54..d0a640f8 100644 --- a/asterius/src/Asterius/EDSL.hs +++ b/asterius/src/Asterius/EDSL.hs @@ -237,12 +237,12 @@ pointer vt b bp o = LVal bytes = b, offset = fromIntegral o, valueType = vt, - ptr = wrapInt64 bp + ptr = bp }, putLVal = \v -> emit $ Store { bytes = b, offset = fromIntegral o, - ptr = wrapInt64 bp, + ptr = bp, value = v, valueType = vt } @@ -296,7 +296,7 @@ nandInt64 :: Expression -> Expression -> Expression nandInt64 e1 e2 = notInt64 $ andInt64 e1 e2 unTagClosure :: Expression -> Expression -unTagClosure p = p `andInt64` constI64 0xFFFFFFFFFFFFFFF8 +unTagClosure p = p `andInt32` constI32 0xFFFFFFFC dynamicTableBase :: Expression dynamicTableBase = @@ -356,7 +356,7 @@ callImport' f xs vt = do callIndirect :: Expression -> EDSL () callIndirect f = emit CallIndirect - { indirectTarget = wrapInt64 f, + { indirectTarget = f, operands = [], functionType = FunctionType {paramTypes = [], returnTypes = []} } diff --git a/asterius/src/Asterius/Foreign/SupportedTypes.hs b/asterius/src/Asterius/Foreign/SupportedTypes.hs index a3755bfd..d3346e00 100644 --- a/asterius/src/Asterius/Foreign/SupportedTypes.hs +++ b/asterius/src/Asterius/Foreign/SupportedTypes.hs @@ -47,10 +47,12 @@ getFFIValueTypeRep tc = case GHC.tyConPrimRep tc of [GHC.IntRep] -> FFIIntRep [GHC.Int8Rep] -> FFIInt8Rep [GHC.Int16Rep] -> FFIInt16Rep + [GHC.Int32Rep] -> FFIInt32Rep [GHC.Int64Rep] -> FFIInt64Rep [GHC.WordRep] -> FFIWordRep [GHC.Word8Rep] -> FFIWord8Rep [GHC.Word16Rep] -> FFIWord16Rep + [GHC.Word32Rep] -> FFIWord32Rep [GHC.Word64Rep] -> FFIWord64Rep [GHC.AddrRep] -> FFIAddrRep [GHC.FloatRep] -> FFIFloatRep @@ -133,7 +135,7 @@ ffiBoxedValueTypeMap0 = ), ( GHC.int64TyConName, FFIValueType - { ffiValueTypeRep = getFFIValueTypeRep GHC.intPrimTyCon, + { ffiValueTypeRep = getFFIValueTypeRep GHC.int64PrimTyCon, hsTyCon = "Int64" } ), @@ -163,7 +165,7 @@ ffiBoxedValueTypeMap0 = ), ( GHC.word64TyConName, FFIValueType - { ffiValueTypeRep = getFFIValueTypeRep GHC.wordPrimTyCon, + { ffiValueTypeRep = getFFIValueTypeRep GHC.word64PrimTyCon, hsTyCon = "Word64" } ), diff --git a/asterius/src/Asterius/FrontendPlugin.hs b/asterius/src/Asterius/FrontendPlugin.hs index c89b08e2..3e510b08 100644 --- a/asterius/src/Asterius/FrontendPlugin.hs +++ b/asterius/src/Asterius/FrontendPlugin.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module Asterius.FrontendPlugin @@ -15,7 +14,6 @@ import Asterius.Internals.PrettyShow import Asterius.JSFFI import Asterius.Types import Asterius.TypesConv -import Control.Exception import Control.Monad import Control.Monad.IO.Class import Data.IORef @@ -90,19 +88,16 @@ frontendPlugin = do ffi_mod <- getFFIModule dflags this_mod m_spt_entries <- atomicModifyIORef' spt_entries_map_ref $ \m -> swap $ M.updateLookupWithKey (\_ _ -> Nothing) this_mod m - runCodeGen + m' <- runCodeGen ( case m_spt_entries of Just spt_entries -> marshalHaskellIR this_mod spt_entries ir _ -> marshalCmmIR this_mod ir ) dflags this_mod - >>= \case - Left err -> throwIO err - Right m' -> do - let m = ffi_mod <> m' - putFile obj_path $ toCachedModule m - when is_debug $ do + let m = ffi_mod <> m' + putFile obj_path $ toCachedModule m + when is_debug $ do let p = (obj_path -<.>) writeFile (p "dump-wasm-ast") =<< prettyShow m cmm_raw <- Stream.collect cmmRaw diff --git a/asterius/src/Asterius/GHCi/Internals.hs b/asterius/src/Asterius/GHCi/Internals.hs index badaece7..03e5f71b 100644 --- a/asterius/src/Asterius/GHCi/Internals.hs +++ b/asterius/src/Asterius/GHCi/Internals.hs @@ -480,7 +480,6 @@ asteriusHscCompileCoreExpr hsc_env srcspan ds_expr = do raw_cmms <- GHC.cmmToRawCmm dflags cmms m <- runCodeGen (marshalRawCmm this_mod raw_cmms) dflags this_mod - >>= either throwIO pure this_id <- modifyMVar globalGHCiState $ \s -> do let this_id = succ $ ghciLastCompiledCoreExpr s pure diff --git a/asterius/src/Asterius/Internals.hs b/asterius/src/Asterius/Internals.hs index 5e722a22..87d72bff 100644 --- a/asterius/src/Asterius/Internals.hs +++ b/asterius/src/Asterius/Internals.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE UnboxedTuples #-} module Asterius.Internals ( encodeStorable, diff --git a/asterius/src/Asterius/Internals/MagicNumber.hs b/asterius/src/Asterius/Internals/MagicNumber.hs index 9a9cfeac..13326bab 100644 --- a/asterius/src/Asterius/Internals/MagicNumber.hs +++ b/asterius/src/Asterius/Internals/MagicNumber.hs @@ -9,15 +9,15 @@ where import Data.Int import Data.Word -invalidAddress :: Int64 +invalidAddress :: Int32 invalidAddress = 0x001fffffffff0000 -- | Base address for functions. NOTE: reserve 0 for the null function pointer. defaultTableBase :: Word32 defaultTableBase = 1024 -mkStaticDataAddress :: Word32 -> Word32 -> Int64 +mkStaticDataAddress :: Word32 -> Word32 -> Int32 mkStaticDataAddress memory_base off = fromIntegral (memory_base + off) -mkStaticFunctionAddress :: Word32 -> Int64 +mkStaticFunctionAddress :: Word32 -> Int32 mkStaticFunctionAddress off = fromIntegral (defaultTableBase + off) diff --git a/asterius/src/Asterius/Internals/Temp.hs b/asterius/src/Asterius/Internals/Temp.hs index 217800c0..2ba3b3b5 100644 --- a/asterius/src/Asterius/Internals/Temp.hs +++ b/asterius/src/Asterius/Internals/Temp.hs @@ -13,7 +13,6 @@ where import Distribution.Simple.Utils import Distribution.Verbosity import System.Directory -import System.FilePath import System.IO -- | Create a temporary file using a file name template. diff --git a/asterius/src/Asterius/JSFFI.hs b/asterius/src/Asterius/JSFFI.hs index 5d03aa67..a11bc6be 100644 --- a/asterius/src/Asterius/JSFFI.hs +++ b/asterius/src/Asterius/JSFFI.hs @@ -28,23 +28,24 @@ import Data.List import qualified Data.Map.Strict as M import qualified GhcPlugins as GHC import Language.Haskell.GHC.Toolkit.Constants +import qualified CmmCallConv as GHC recoverWasmWrapperValueType :: FFIValueType -> ValueType recoverWasmWrapperValueType FFIValueType {..} = case ffiValueTypeRep of - FFILiftedRep -> I64 - FFIUnliftedRep -> I64 - FFIJSValRep -> I64 - FFIIntRep -> I64 + FFILiftedRep -> I32 + FFIUnliftedRep -> I32 + FFIJSValRep -> I32 + FFIIntRep -> I32 FFIInt8Rep -> I32 FFIInt16Rep -> I32 FFIInt32Rep -> I32 FFIInt64Rep -> I64 - FFIWordRep -> I64 + FFIWordRep -> I32 FFIWord8Rep -> I32 FFIWord16Rep -> I32 FFIWord32Rep -> I32 FFIWord64Rep -> I64 - FFIAddrRep -> I64 + FFIAddrRep -> I32 FFIFloatRep -> F32 FFIDoubleRep -> F64 @@ -58,8 +59,8 @@ recoverWasmImportFunctionType ffi_safety FFIFunctionType {..} | otherwise = FunctionType {paramTypes = param_types, returnTypes = []} where is_unsafe = ffi_safety == FFIUnsafe - param_types = map (const F64) ffiParamTypes - ret_types = map (const F64) ffiResultTypes + param_types = map recoverWasmWrapperValueType ffiParamTypes + ret_types = map recoverWasmWrapperValueType ffiResultTypes recoverWasmWrapperFunctionType :: FFISafety -> FFIFunctionType -> FunctionType recoverWasmWrapperFunctionType ffi_safety FFIFunctionType {..} @@ -87,27 +88,10 @@ getFFIModule dflags ms_mod = do generateImplicitCastExpression :: Bool -> [ValueType] -> [ValueType] -> Expression -> Expression -generateImplicitCastExpression signed src_ts dest_ts src_expr = - case (src_ts, dest_ts) of - ([I64], [F64]) -> - Unary - { unaryOp = - if signed - then ConvertSInt64ToFloat64 - else ConvertUInt64ToFloat64, - operand0 = src_expr - } - ([F64], [I64]) -> - Unary - { unaryOp = if signed then TruncSFloat64ToInt64 else TruncUFloat64ToInt64, - operand0 = src_expr - } - ([F32], [F64]) -> Unary {unaryOp = PromoteFloat32, operand0 = src_expr} - ([F64], [F32]) -> Unary {unaryOp = DemoteFloat64, operand0 = src_expr} - _ - | src_ts == dest_ts -> +generateImplicitCastExpression signed src_ts dest_ts src_expr + | src_ts == dest_ts = src_expr - | otherwise -> + | otherwise = error $ "Unsupported implicit cast from " <> show src_ts @@ -158,7 +142,9 @@ marshalParamLocation :: GHC.ParamLocation -> UnresolvedGlobalReg marshalParamLocation (GHC.RegisterParam (GHC.VanillaReg i _)) = VanillaReg i marshalParamLocation (GHC.RegisterParam (GHC.FloatReg i)) = FloatReg i marshalParamLocation (GHC.RegisterParam (GHC.DoubleReg i)) = DoubleReg i -marshalParamLocation _ = error "Asterius.JSFFI.marshalParamLocation" +marshalParamLocation (GHC.RegisterParam (GHC.LongReg i)) = LongReg i +marshalParamLocation (GHC.RegisterParam x) = error $ "Asterius.JSFFI.marshalParamLocation: RegisterParam " <> show x +marshalParamLocation (GHC.StackParam x) = error $ "Asterius.JSFFI.marshalParamLocation: StackParam " <> show x recoverCmmType :: GHC.DynFlags -> FFIValueType -> GHC.CmmType recoverCmmType dflags FFIValueType {..} = case ffiValueTypeRep of @@ -206,24 +192,24 @@ asyncImportWrapper dflags k FFIImportDecl {..} = callImportReturnTypes = [] }, Store - { bytes = 8, + { bytes = 4, offset = fromIntegral $ offset_Capability_r + offset_StgRegTable_rRet, - ptr = wrapInt64 mainCapability, - value = constI64 ret_ThreadBlocked, - valueType = I64 + ptr = mainCapability, + value = constI32 ret_ThreadBlocked, + valueType = I32 }, Store { bytes = 2, offset = fromIntegral offset_StgTSO_why_blocked, - ptr = wrapInt64 $ unresolvedGetGlobal CurrentTSO, + ptr = unresolvedGetGlobal CurrentTSO, value = constI32 blocked_BlockedOnCCall, valueType = I32 }, ReturnCall - { returnCallTarget64 = "stg_returnToSchedNotPaused" + { returnCallTarget = "stg_returnToSchedNotPaused" } ], blockReturnTypes = [] diff --git a/asterius/src/Asterius/JSRun/NonMain.hs b/asterius/src/Asterius/JSRun/NonMain.hs index 3724a3a1..bd73c6af 100644 --- a/asterius/src/Asterius/JSRun/NonMain.hs +++ b/asterius/src/Asterius/JSRun/NonMain.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} module Asterius.JSRun.NonMain ( distNonMain, diff --git a/asterius/src/Asterius/Main.hs b/asterius/src/Asterius/Main.hs index deb986ea..831d2c5e 100644 --- a/asterius/src/Asterius/Main.hs +++ b/asterius/src/Asterius/Main.hs @@ -11,7 +11,6 @@ module Asterius.Main ) where -import qualified Asterius.Backends.Binaryen import qualified Asterius.Backends.Binaryen as Binaryen import qualified Asterius.Backends.Binaryen.RunPass as Binaryen import Asterius.Binary.File @@ -38,10 +37,8 @@ import qualified Asterius.Types.SymbolSet as SS import qualified Binaryen import qualified Binaryen.Module as Binaryen import Control.Monad -import Data.Binary.Get import qualified Data.ByteString as BS import Data.ByteString.Builder -import qualified Data.ByteString.Lazy as LBS import Data.Foldable import Data.List import Data.String @@ -274,7 +271,7 @@ ahcDistMain logger task (final_m, report) = do out_js = outputDirectory task outputBaseName task <.> "js" out_html = outputDirectory task outputBaseName task <.> "html" logger "[INFO] Converting linked IR to binaryen IR" - Binaryen.setDebugInfo $ if verboseErr task then 1 else 0 + Binaryen.setDebugInfo 1 -- $ if verboseErr task then 1 else 0 Binaryen.setOptimizeLevel $ fromIntegral $ optimizeLevel task Binaryen.setShrinkLevel $ fromIntegral $ shrinkLevel task Binaryen.setLowMemoryUnused 1 diff --git a/asterius/src/Asterius/Main/Task.hs b/asterius/src/Asterius/Main/Task.hs index 157d07e4..5c434ae5 100644 --- a/asterius/src/Asterius/Main/Task.hs +++ b/asterius/src/Asterius/Main/Task.hs @@ -49,8 +49,8 @@ data Task defTask :: Task defTask = Task { target = Node, - optimizeLevel = 4, - shrinkLevel = 2, + optimizeLevel = 0, + shrinkLevel = 0, inputHS = error "Asterius.Main.parseTask: missing inputHS", outputDirectory = error "Asterius.Main.parseTask: missing outputDirectory", outputBaseName = error "Asterius.Main.parseTask: missing outputBaseName", diff --git a/asterius/src/Asterius/MemoryTrap.hs b/asterius/src/Asterius/MemoryTrap.hs index 77c09c53..67987379 100644 --- a/asterius/src/Asterius/MemoryTrap.hs +++ b/asterius/src/Asterius/MemoryTrap.hs @@ -27,27 +27,27 @@ addMemoryTrapDeep sym = w w :: Data a => a -> a w t = case eqTypeRep (typeOf t) (typeRep :: TypeRep Expression) of Just HRefl -> case t of - Load {ptr = Unary {unaryOp = WrapInt64, operand0 = i64_ptr}, ..} -> - let new_i64_ptr = w i64_ptr + Load {ptr = i32_ptr, ..} -> + let new_i32_ptr = w i32_ptr in CallImport { target' = "__asterius_load_" <> load_fn_suffix valueType bytes signed, operands = [ Symbol {unresolvedSymbol = sym, symbolOffset = 0}, - new_i64_ptr, + new_i32_ptr, ConstI32 $ fromIntegral offset ], callImportReturnTypes = [valueType] } - Store {ptr = Unary {unaryOp = WrapInt64, operand0 = i64_ptr}, ..} -> - let new_i64_ptr = w i64_ptr + Store {ptr = i32_ptr, ..} -> + let new_i32_ptr = w i32_ptr new_value = w value in CallImport { target' = "__asterius_store_" <> store_fn_suffix valueType bytes, operands = [ Symbol {unresolvedSymbol = sym, symbolOffset = 0}, - new_i64_ptr, + new_i32_ptr, ConstI32 $ fromIntegral offset, new_value ], diff --git a/asterius/src/Asterius/Passes/CCall.hs b/asterius/src/Asterius/Passes/CCall.hs index 97403e0b..f21e4194 100644 --- a/asterius/src/Asterius/Passes/CCall.hs +++ b/asterius/src/Asterius/Passes/CCall.hs @@ -15,25 +15,16 @@ handleCCall :: M.Map BS.ByteString (BS.ByteString, FunctionType) -> Expression -> Expression -handleCCall libc_func_info e@Call {callHint = Just (args_hints, res_hints), ..} +handleCCall libc_func_info e@Call {callHint = Just (_, res_hints), ..} | Just (in_name, FunctionType {..}) <- entityName target `M.lookup` libc_func_info = let res_trans = case (returnTypes, res_hints, callReturnTypes) of ([_], [_], []) -> Drop - ([I32], [NoHint], [I64]) -> extendUInt32 - ([I32], [AddrHint], [I64]) -> extendUInt32 - ([I32], [SignedHint], [I64]) -> extendSInt32 _ -> id in res_trans e { target = mkEntitySymbol in_name, - operands = - [ case (t1, h, t0) of - (I32, _, [I64]) -> wrapInt64 x - _ -> x - | (x, t1, h) <- zip3 operands paramTypes args_hints, - let t0 = infer x - ], + operands = operands, callReturnTypes = returnTypes, callHint = Nothing } diff --git a/asterius/src/Asterius/Passes/DataOffsetTable.hs b/asterius/src/Asterius/Passes/DataOffsetTable.hs index 4cb5c05a..5dbbae3a 100644 --- a/asterius/src/Asterius/Passes/DataOffsetTable.hs +++ b/asterius/src/Asterius/Passes/DataOffsetTable.hs @@ -24,12 +24,12 @@ import Asterius.JSGen.Wizer -- | Segments are 8-bytes aligned. {-# INLINE segAlignment #-} segAlignment :: Int -segAlignment = 8 +segAlignment = 4 {-# INLINEABLE sizeofStatic #-} sizeofStatic :: AsteriusStatic -> Word32 sizeofStatic = \case - SymbolStatic {} -> 8 + SymbolStatic {} -> 4 Uninitialized x -> fromIntegral x Serialized buf -> fromIntegral $ BS.length buf diff --git a/asterius/src/Asterius/Passes/GCSections.hs b/asterius/src/Asterius/Passes/GCSections.hs index 38a8f9dd..02643fe9 100644 --- a/asterius/src/Asterius/Passes/GCSections.hs +++ b/asterius/src/Asterius/Passes/GCSections.hs @@ -1,8 +1,6 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} module Asterius.Passes.GCSections diff --git a/asterius/src/Asterius/Passes/GlobalRegs.hs b/asterius/src/Asterius/Passes/GlobalRegs.hs index edef24c9..3b7b1e09 100644 --- a/asterius/src/Asterius/Passes/GlobalRegs.hs +++ b/asterius/src/Asterius/Passes/GlobalRegs.hs @@ -7,22 +7,21 @@ module Asterius.Passes.GlobalRegs ) where -import Asterius.EDSL.UnaryOp import Asterius.Types import Language.Haskell.GHC.Toolkit.Constants globalRegInfo :: UnresolvedGlobalReg -> (BinaryenIndex, Int, ValueType) globalRegInfo gr = case gr of - VanillaReg 1 -> (8, offset_StgRegTable_rR1, I64) - VanillaReg 2 -> (8, offset_StgRegTable_rR2, I64) - VanillaReg 3 -> (8, offset_StgRegTable_rR3, I64) - VanillaReg 4 -> (8, offset_StgRegTable_rR4, I64) - VanillaReg 5 -> (8, offset_StgRegTable_rR5, I64) - VanillaReg 6 -> (8, offset_StgRegTable_rR6, I64) - VanillaReg 7 -> (8, offset_StgRegTable_rR7, I64) - VanillaReg 8 -> (8, offset_StgRegTable_rR8, I64) - VanillaReg 9 -> (8, offset_StgRegTable_rR9, I64) - VanillaReg 10 -> (8, offset_StgRegTable_rR10, I64) + VanillaReg 1 -> (4, offset_StgRegTable_rR1, I32) + VanillaReg 2 -> (4, offset_StgRegTable_rR2, I32) + VanillaReg 3 -> (4, offset_StgRegTable_rR3, I32) + VanillaReg 4 -> (4, offset_StgRegTable_rR4, I32) + VanillaReg 5 -> (4, offset_StgRegTable_rR5, I32) + VanillaReg 6 -> (4, offset_StgRegTable_rR6, I32) + VanillaReg 7 -> (4, offset_StgRegTable_rR7, I32) + VanillaReg 8 -> (4, offset_StgRegTable_rR8, I32) + VanillaReg 9 -> (4, offset_StgRegTable_rR9, I32) + VanillaReg 10 -> (4, offset_StgRegTable_rR10, I32) FloatReg 1 -> (4, offset_StgRegTable_rF1, F32) FloatReg 2 -> (4, offset_StgRegTable_rF2, F32) FloatReg 3 -> (4, offset_StgRegTable_rF3, F32) @@ -36,17 +35,17 @@ globalRegInfo gr = case gr of DoubleReg 5 -> (8, offset_StgRegTable_rD5, F64) DoubleReg 6 -> (8, offset_StgRegTable_rD6, F64) LongReg 1 -> (8, offset_StgRegTable_rL1, I64) - Sp -> (8, offset_StgRegTable_rSp, I64) - SpLim -> (8, offset_StgRegTable_rSpLim, I64) - Hp -> (8, offset_StgRegTable_rHp, I64) - HpLim -> (8, offset_StgRegTable_rHpLim, I64) - CCCS -> (8, offset_StgRegTable_rCCCS, I64) - CurrentTSO -> (8, offset_StgRegTable_rCurrentTSO, I64) - CurrentNursery -> (8, offset_StgRegTable_rCurrentNursery, I64) - HpAlloc -> (8, offset_StgRegTable_rHpAlloc, I64) - EagerBlackholeInfo -> (8, rf + offset_StgFunTable_stgEagerBlackholeInfo, I64) - GCEnter1 -> (8, rf + offset_StgFunTable_stgGCEnter1, I64) - GCFun -> (8, rf + offset_StgFunTable_stgGCFun, I64) + Sp -> (4, offset_StgRegTable_rSp, I32) + SpLim -> (4, offset_StgRegTable_rSpLim, I32) + Hp -> (4, offset_StgRegTable_rHp, I32) + HpLim -> (4, offset_StgRegTable_rHpLim, I32) + CCCS -> (4, offset_StgRegTable_rCCCS, I32) + CurrentTSO -> (4, offset_StgRegTable_rCurrentTSO, I32) + CurrentNursery -> (4, offset_StgRegTable_rCurrentNursery, I32) + HpAlloc -> (4, offset_StgRegTable_rHpAlloc, I32) + EagerBlackholeInfo -> (4, rf + offset_StgFunTable_stgEagerBlackholeInfo, I32) + GCEnter1 -> (4, rf + offset_StgFunTable_stgGCEnter1, I32) + GCFun -> (4, rf + offset_StgFunTable_stgGCFun, I32) _ -> error $ "Asterius.Passes.GlobalRegs.resolveGlobalRegs: Unsupported global reg " @@ -57,9 +56,6 @@ globalRegInfo gr = case gr of mainCap :: Expression mainCap = Symbol {unresolvedSymbol = "MainCapability", symbolOffset = 0} -mainCap32 :: Expression -mainCap32 = wrapInt64 mainCap - baseReg :: Expression baseReg = mainCap {symbolOffset = offset_Capability_r} @@ -71,7 +67,7 @@ unresolvedGetGlobal gr = case gr of bytes = b, offset = fromIntegral $ offset_Capability_r + o, valueType = vt, - ptr = mainCap32 + ptr = mainCap } where (b, o, vt) = globalRegInfo gr @@ -82,7 +78,7 @@ unresolvedSetGlobal gr v = case gr of _ -> Store { bytes = b, offset = fromIntegral $ offset_Capability_r + o, - ptr = mainCap32, + ptr = mainCap, value = v, valueType = vt } diff --git a/asterius/src/Asterius/Passes/Relooper.hs b/asterius/src/Asterius/Passes/Relooper.hs new file mode 100644 index 00000000..c02146b1 --- /dev/null +++ b/asterius/src/Asterius/Passes/Relooper.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Asterius.Passes.Relooper + ( relooper, + ) +where + +import Asterius.Types +import Data.Foldable +import Data.List +import qualified Data.Map.Strict as M + +{-# INLINE relooper #-} +relooper :: RelooperRun -> Expression +relooper cfg@RelooperRun {blockMap = oldMap} = + relooper' $ + cfg + { blockMap = M.insert "__asterius_unreachable" unreachableRelooperBlock oldMap + } + +relooper' :: RelooperRun -> Expression +relooper' RelooperRun {..} = result_expr + where + lbls = M.keys blockMap + lbl_map = M.fromList $ zip lbls [0 ..] + lbl_to_idx = (lbl_map M.!) + set_block_lbl lbl = SetLocal {index = 0, value = ConstI32 $ lbl_to_idx lbl} + initial_expr = Switch + { names = lbls, + defaultName = "__asterius_unreachable", + condition = GetLocal {index = 0, valueType = I32} + } + loop_lbl = "__asterius_loop" + exit_lbl = "__asterius_exit" + (blocks_expr, last_block_residule_exprs) = + M.foldlWithKey' + ( \(tot_expr, residule_exprs) lbl RelooperBlock {..} -> + ( Block + { name = lbl, + bodys = tot_expr : residule_exprs, + blockReturnTypes = [] + }, + case addBlock of + AddBlock {..} -> + code + : ( case addBranches of + [] -> [Break {name = exit_lbl, breakCondition = Nothing}] + branches -> + foldr' + ( \AddBranch {addBranchCondition = Just cond, to} e -> If + { condition = cond, + ifTrue = set_block_lbl to, + ifFalse = Just e + } + ) + (set_block_lbl $ to def_branch) + (init branches) + : [Break {name = loop_lbl, breakCondition = Nothing}] + where + def_branch@AddBranch {addBranchCondition = Nothing} = + last branches + ) + AddBlockWithSwitch {..} -> + [code, SetLocal {index = 1, value = condition}] + <> ( foldr' + ( \AddBranchForSwitch {to, indexes} e -> If + { condition = + foldl1' + (Binary OrInt32) + [ Binary + { binaryOp = EqInt32, + operand0 = GetLocal + { index = 1, + valueType = I32 + }, + operand1 = ConstI32 $ fromIntegral tag + } + | tag <- indexes + ], + ifTrue = set_block_lbl to, + ifFalse = Just e + } + ) + (set_block_lbl $ to def_branch) + (init branches) + : [Break {name = loop_lbl, breakCondition = Nothing}] + ) + where + branches = addBranches + def_branch@AddBranch {addBranchCondition = Nothing} = last branches + ) + ) + (initial_expr, []) + blockMap + result_expr = Block + { name = exit_lbl, + bodys = + [ set_block_lbl entry, + Loop + { name = loop_lbl, + body = Block + { name = "", + bodys = blocks_expr : last_block_residule_exprs, + blockReturnTypes = [] + } + } + ], + blockReturnTypes = [] + } diff --git a/asterius/src/Asterius/Resolve.hs b/asterius/src/Asterius/Resolve.hs index fbfa1d80..4e8fd812 100644 --- a/asterius/src/Asterius/Resolve.hs +++ b/asterius/src/Asterius/Resolve.hs @@ -2,7 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} module Asterius.Resolve ( unresolvedGlobalRegType, @@ -28,13 +27,13 @@ import Control.DeepSeq import qualified Data.Map.Lazy as LM import Data.String import Foreign -import Language.Haskell.GHC.Toolkit.Constants unresolvedGlobalRegType :: UnresolvedGlobalReg -> ValueType unresolvedGlobalRegType gr = case gr of + LongReg _ -> I64 FloatReg _ -> F32 DoubleReg _ -> F64 - _ -> I64 + _ -> I32 makeInfoTableOffsetSet :: AsteriusModule -> SM.SymbolMap Word32 -> [Word32] makeInfoTableOffsetSet AsteriusModule {..} ss_off_map = diff --git a/asterius/src/Asterius/TypeInfer.hs b/asterius/src/Asterius/TypeInfer.hs index dc57c8e9..ebd7b768 100644 --- a/asterius/src/Asterius/TypeInfer.hs +++ b/asterius/src/Asterius/TypeInfer.hs @@ -24,7 +24,7 @@ infer expr = case expr of Switch {} -> [] Call {..} -> callReturnTypes CallImport {..} -> callImportReturnTypes - CallIndirect {} -> [I64] + CallIndirect {} -> [I32] GetLocal {..} -> [valueType] SetLocal {} -> [] TeeLocal {..} -> [valueType] @@ -41,7 +41,7 @@ infer expr = case expr of Nop -> [] Unreachable -> [] CFG {} -> [] - Symbol {} -> [I64] + Symbol {} -> [I32] UnresolvedGetLocal {..} -> [typeOfUnresolvedLocalReg unresolvedLocalReg] UnresolvedSetLocal {} -> [] Drop {} -> [] @@ -122,6 +122,12 @@ inferUnaryOp = \case ReinterpretInt64 -> (I64, F64) PromoteFloat32 -> (F32, F64) + ExtendS8Int32 -> (I32, I32) + ExtendS16Int32 -> (I32, I32) + ExtendS8Int64 -> (I32, I64) + ExtendS16Int64 -> (I32, I64) + ExtendS32Int64 -> (I32, I64) + -- | Infer the type of a binary operator as -- @((input_type_1, input_type_2), output_type)@. inferBinaryOp :: BinaryOp -> ((ValueType, ValueType), ValueType) diff --git a/ghc-toolkit/cbits/ghc_constants.c b/ghc-toolkit/cbits/ghc_constants.c index c088f7ac..d5fc5717 100644 --- a/ghc-toolkit/cbits/ghc_constants.c +++ b/ghc-toolkit/cbits/ghc_constants.c @@ -2,563 +2,568 @@ #include "Schedule.h" #include "Capability.h" -HsInt offset_timespec_tv_sec() { return offsetof(struct timespec, tv_sec); } +__attribute__((export_name("offset_timespec_tv_sec"))) uint32_t offset_timespec_tv_sec() { return offsetof(struct timespec, tv_sec); } -HsInt offset_timespec_tv_nsec() { return offsetof(struct timespec, tv_nsec); } +__attribute__((export_name("offset_timespec_tv_nsec"))) uint32_t offset_timespec_tv_nsec() { return offsetof(struct timespec, tv_nsec); } -HsInt roundup(HsInt x, HsInt n) { return (x + (n - 1)) & (~(n - 1)); } +__attribute__((export_name("roundup"))) uint32_t roundup(uint32_t x, uint32_t n) { return (x + (n - 1)) & (~(n - 1)); } -HsInt roundup_bytes_to_words(HsInt n) { return ROUNDUP_BYTES_TO_WDS(n); } +__attribute__((export_name("roundup_bytes_to_words"))) uint32_t roundup_bytes_to_words(uint32_t n) { return ROUNDUP_BYTES_TO_WDS(n); } -HsInt block_size() { return BLOCK_SIZE; } +__attribute__((export_name("block_size"))) uint32_t block_size() { return BLOCK_SIZE; } -HsInt mblock_size() { return MBLOCK_SIZE; } +__attribute__((export_name("mblock_size"))) uint32_t mblock_size() { return MBLOCK_SIZE; } -HsInt blocks_per_mblock() { return BLOCKS_PER_MBLOCK; } +__attribute__((export_name("blocks_per_mblock"))) uint32_t blocks_per_mblock() { return BLOCKS_PER_MBLOCK; } -HsInt offset_first_bdescr() { return (HsInt)FIRST_BDESCR(0); } +__attribute__((export_name("offset_first_bdescr"))) uint32_t offset_first_bdescr() { return (uint32_t)FIRST_BDESCR(0); } -HsInt offset_last_bdescr() { return (HsInt)LAST_BDESCR(0); } +__attribute__((export_name("offset_last_bdescr"))) uint32_t offset_last_bdescr() { return (uint32_t)LAST_BDESCR(0); } -HsInt offset_first_block() { return (HsInt)FIRST_BLOCK(0); } +__attribute__((export_name("offset_first_block"))) uint32_t offset_first_block() { return (uint32_t)FIRST_BLOCK(0); } -HsInt offset_last_block() { return (HsInt)LAST_BLOCK(0); } +__attribute__((export_name("offset_last_block"))) uint32_t offset_last_block() { return (uint32_t)LAST_BLOCK(0); } -HsInt sizeof_bdescr() { return sizeof(bdescr); } +__attribute__((export_name("sizeof_bdescr"))) uint32_t sizeof_bdescr() { return sizeof(bdescr); } -HsInt offset_bdescr_start() { return offsetof(bdescr, start); } +__attribute__((export_name("offset_bdescr_start"))) uint32_t offset_bdescr_start() { return offsetof(bdescr, start); } -HsInt offset_bdescr_free() { return offsetof(bdescr, free); } +__attribute__((export_name("offset_bdescr_free"))) uint32_t offset_bdescr_free() { return offsetof(bdescr, free); } -HsInt offset_bdescr_link() { return offsetof(bdescr, link); } +__attribute__((export_name("offset_bdescr_link"))) uint32_t offset_bdescr_link() { return offsetof(bdescr, link); } -HsInt offset_bdescr_gen_no() { return offsetof(bdescr, gen_no); } +__attribute__((export_name("offset_bdescr_gen_no"))) uint32_t offset_bdescr_gen_no() { return offsetof(bdescr, gen_no); } -HsInt offset_bdescr_node() { return offsetof(bdescr, node); } +__attribute__((export_name("offset_bdescr_node"))) uint32_t offset_bdescr_node() { return offsetof(bdescr, node); } -HsInt offset_bdescr_flags() { return offsetof(bdescr, flags); } +__attribute__((export_name("offset_bdescr_flags"))) uint32_t offset_bdescr_flags() { return offsetof(bdescr, flags); } -HsInt offset_bdescr_blocks() { return offsetof(bdescr, blocks); } +__attribute__((export_name("offset_bdescr_blocks"))) uint32_t offset_bdescr_blocks() { return offsetof(bdescr, blocks); } -HsInt sizeof_Capability() { return sizeof(Capability); } +__attribute__((export_name("sizeof_Capability"))) uint32_t sizeof_Capability() { return sizeof(Capability); } -HsInt offset_Capability_f() { return offsetof(Capability, f); } +__attribute__((export_name("offset_Capability_f"))) uint32_t offset_Capability_f() { return offsetof(Capability, f); } -HsInt offset_Capability_r() { return offsetof(Capability, r); } +__attribute__((export_name("offset_Capability_r"))) uint32_t offset_Capability_r() { return offsetof(Capability, r); } -HsInt offset_Capability_no() { return offsetof(Capability, no); } +__attribute__((export_name("offset_Capability_no"))) uint32_t offset_Capability_no() { return offsetof(Capability, no); } -HsInt offset_Capability_node() { return offsetof(Capability, node); } +__attribute__((export_name("offset_Capability_node"))) uint32_t offset_Capability_node() { return offsetof(Capability, node); } -HsInt offset_Capability_running_task() { - return offsetof(Capability, running_task); +__attribute__((export_name("offset_Capability_running_task"))) uint32_t offset_Capability_running_task() { +return offsetof(Capability, running_task); } -HsInt offset_Capability_in_haskell() { - return offsetof(Capability, in_haskell); +__attribute__((export_name("offset_Capability_in_haskell"))) uint32_t offset_Capability_in_haskell() { +return offsetof(Capability, in_haskell); } -HsInt offset_Capability_idle() { return offsetof(Capability, idle); } +__attribute__((export_name("offset_Capability_idle"))) uint32_t offset_Capability_idle() { return offsetof(Capability, idle); } -HsInt offset_Capability_disabled() { return offsetof(Capability, disabled); } +__attribute__((export_name("offset_Capability_disabled"))) uint32_t offset_Capability_disabled() { return offsetof(Capability, disabled); } -HsInt offset_Capability_run_queue_hd() { - return offsetof(Capability, run_queue_hd); +__attribute__((export_name("offset_Capability_run_queue_hd"))) uint32_t offset_Capability_run_queue_hd() { +return offsetof(Capability, run_queue_hd); } -HsInt offset_Capability_run_queue_tl() { - return offsetof(Capability, run_queue_tl); +__attribute__((export_name("offset_Capability_run_queue_tl"))) uint32_t offset_Capability_run_queue_tl() { +return offsetof(Capability, run_queue_tl); } -HsInt offset_Capability_n_run_queue() { - return offsetof(Capability, n_run_queue); -} -HsInt offset_Capability_suspended_ccalls() { - return offsetof(Capability, suspended_ccalls); -} -HsInt offset_Capability_n_suspended_ccalls() { - return offsetof(Capability, n_suspended_ccalls); +__attribute__((export_name("offset_Capability_n_run_queue"))) uint32_t offset_Capability_n_run_queue() { +return offsetof(Capability, n_run_queue); } -HsInt offset_Capability_mut_lists() { return offsetof(Capability, mut_lists); } - -HsInt offset_Capability_saved_mut_lists() { - return offsetof(Capability, saved_mut_lists); +__attribute__((export_name("offset_Capability_suspended_ccalls"))) uint32_t offset_Capability_suspended_ccalls() { +return offsetof(Capability, suspended_ccalls); } -HsInt offset_Capability_pinned_object_block() { - return offsetof(Capability, pinned_object_block); -} -HsInt offset_Capability_pinned_object_blocks() { - return offsetof(Capability, pinned_object_blocks); +__attribute__((export_name("offset_Capability_n_suspended_ccalls"))) uint32_t offset_Capability_n_suspended_ccalls() { +return offsetof(Capability, n_suspended_ccalls); } -HsInt offset_Capability_weak_ptr_list_hd() { - return offsetof(Capability, weak_ptr_list_hd); +__attribute__((export_name("offset_Capability_mut_lists"))) uint32_t offset_Capability_mut_lists() { return offsetof(Capability, mut_lists); } + +__attribute__((export_name("offset_Capability_saved_mut_lists"))) uint32_t offset_Capability_saved_mut_lists() { +return offsetof(Capability, saved_mut_lists); } -HsInt offset_Capability_weak_ptr_list_tl() { - return offsetof(Capability, weak_ptr_list_tl); +__attribute__((export_name("offset_Capability_pinned_object_block"))) uint32_t offset_Capability_pinned_object_block() { +return offsetof(Capability, pinned_object_block); } -HsInt offset_Capability_context_switch() { - return offsetof(Capability, context_switch); +__attribute__((export_name("offset_Capability_pinned_object_blocks"))) uint32_t offset_Capability_pinned_object_blocks() { +return offsetof(Capability, pinned_object_blocks); } -HsInt offset_Capability_interrupt() { return offsetof(Capability, interrupt); } - -HsInt offset_Capability_total_allocated() { - return offsetof(Capability, total_allocated); +__attribute__((export_name("offset_Capability_weak_ptr_list_hd"))) uint32_t offset_Capability_weak_ptr_list_hd() { +return offsetof(Capability, weak_ptr_list_hd); } -HsInt offset_Capability_free_tvar_watch_queues() { - return offsetof(Capability, free_tvar_watch_queues); +__attribute__((export_name("offset_Capability_weak_ptr_list_tl"))) uint32_t offset_Capability_weak_ptr_list_tl() { +return offsetof(Capability, weak_ptr_list_tl); } -HsInt offset_Capability_free_trec_chunks() { - return offsetof(Capability, free_trec_chunks); -} -HsInt offset_Capability_free_trec_headers() { - return offsetof(Capability, free_trec_headers); +__attribute__((export_name("offset_Capability_context_switch"))) uint32_t offset_Capability_context_switch() { +return offsetof(Capability, context_switch); } -HsInt offset_Capability_transaction_tokens() { - return offsetof(Capability, transaction_tokens); +__attribute__((export_name("offset_Capability_interrupt"))) uint32_t offset_Capability_interrupt() { return offsetof(Capability, interrupt); } + +__attribute__((export_name("offset_Capability_total_allocated"))) uint32_t offset_Capability_total_allocated() { +return offsetof(Capability, total_allocated); } -HsInt sizeof_MessageBlackHole() { - return sizeof(MessageBlackHole); +__attribute__((export_name("offset_Capability_free_tvar_watch_queues"))) uint32_t offset_Capability_free_tvar_watch_queues() { +return offsetof(Capability, free_tvar_watch_queues); } -HsInt offset_MessageBlackHole_link() { - return offsetof(MessageBlackHole, link); +__attribute__((export_name("offset_Capability_free_trec_chunks"))) uint32_t offset_Capability_free_trec_chunks() { +return offsetof(Capability, free_trec_chunks); } -HsInt offset_MessageBlackHole_tso() { - return offsetof(MessageBlackHole, tso); +__attribute__((export_name("offset_Capability_free_trec_headers"))) uint32_t offset_Capability_free_trec_headers() { +return offsetof(Capability, free_trec_headers); } -HsInt offset_MessageBlackHole_bh() { - return offsetof(MessageBlackHole, bh); +__attribute__((export_name("offset_Capability_transaction_tokens"))) uint32_t offset_Capability_transaction_tokens() { +return offsetof(Capability, transaction_tokens); } -HsInt sizeof_StgAP() { return sizeof(StgAP); } - -HsInt offset_StgAP_arity() { return offsetof(StgAP, arity); } - -HsInt offset_StgAP_n_args() { return offsetof(StgAP, n_args); } - -HsInt offset_StgAP_fun() { return offsetof(StgAP, fun); } - -HsInt offset_StgAP_payload() { return offsetof(StgAP, payload); } - -HsInt sizeof_StgAP_STACK() { return sizeof(StgAP_STACK); } - -HsInt offset_StgAP_STACK_size() { return offsetof(StgAP_STACK, size); } - -HsInt offset_StgAP_STACK_fun() { return offsetof(StgAP_STACK, fun); } - -HsInt offset_StgAP_STACK_payload() { return offsetof(StgAP_STACK, payload); } - -HsInt sizeof_StgArrBytes() { return sizeof(StgArrBytes); } - -HsInt offset_StgArrBytes_bytes() { return offsetof(StgArrBytes, bytes); } - -HsInt offset_StgArrBytes_payload() { return offsetof(StgArrBytes, payload); } - -HsInt sizeof_StgBlockingQueue() { - return sizeof(StgBlockingQueue); +__attribute__((export_name("sizeof_MessageBlackHole"))) uint32_t sizeof_MessageBlackHole() { +return sizeof(MessageBlackHole); } -HsInt offset_StgBlockingQueue_link() { - return offsetof(StgBlockingQueue, link); +__attribute__((export_name("offset_MessageBlackHole_link"))) uint32_t offset_MessageBlackHole_link() { +return offsetof(MessageBlackHole, link); } -HsInt offset_StgBlockingQueue_bh() { - return offsetof(StgBlockingQueue, bh); +__attribute__((export_name("offset_MessageBlackHole_tso"))) uint32_t offset_MessageBlackHole_tso() { +return offsetof(MessageBlackHole, tso); } -HsInt offset_StgBlockingQueue_owner() { - return offsetof(StgBlockingQueue, owner); +__attribute__((export_name("offset_MessageBlackHole_bh"))) uint32_t offset_MessageBlackHole_bh() { +return offsetof(MessageBlackHole, bh); } -HsInt offset_StgBlockingQueue_queue() { - return offsetof(StgBlockingQueue, queue); +__attribute__((export_name("sizeof_StgAP"))) uint32_t sizeof_StgAP() { return sizeof(StgAP); } + +__attribute__((export_name("offset_StgAP_arity"))) uint32_t offset_StgAP_arity() { return offsetof(StgAP, arity); } + +__attribute__((export_name("offset_StgAP_n_args"))) uint32_t offset_StgAP_n_args() { return offsetof(StgAP, n_args); } + +__attribute__((export_name("offset_StgAP_fun"))) uint32_t offset_StgAP_fun() { return offsetof(StgAP, fun); } + +__attribute__((export_name("offset_StgAP_payload"))) uint32_t offset_StgAP_payload() { return offsetof(StgAP, payload); } + +__attribute__((export_name("sizeof_StgAP_STACK"))) uint32_t sizeof_StgAP_STACK() { return sizeof(StgAP_STACK); } + +__attribute__((export_name("offset_StgAP_STACK_size"))) uint32_t offset_StgAP_STACK_size() { return offsetof(StgAP_STACK, size); } + +__attribute__((export_name("offset_StgAP_STACK_fun"))) uint32_t offset_StgAP_STACK_fun() { return offsetof(StgAP_STACK, fun); } + +__attribute__((export_name("offset_StgAP_STACK_payload"))) uint32_t offset_StgAP_STACK_payload() { return offsetof(StgAP_STACK, payload); } + +__attribute__((export_name("sizeof_StgArrBytes"))) uint32_t sizeof_StgArrBytes() { return sizeof(StgArrBytes); } + +__attribute__((export_name("offset_StgArrBytes_bytes"))) uint32_t offset_StgArrBytes_bytes() { return offsetof(StgArrBytes, bytes); } + +__attribute__((export_name("offset_StgArrBytes_payload"))) uint32_t offset_StgArrBytes_payload() { return offsetof(StgArrBytes, payload); } + +__attribute__((export_name("sizeof_StgBlockingQueue"))) uint32_t sizeof_StgBlockingQueue() { +return sizeof(StgBlockingQueue); } -HsInt sizeof_StgClosure() { return sizeof(StgClosure); } - -HsInt offset_StgClosure_payload() { return offsetof(StgClosure, payload); } - -HsInt sizeof_StgInd() { return sizeof(StgInd); } - -HsInt offset_StgInd_indirectee() { return offsetof(StgInd, indirectee); } - -HsInt sizeof_StgIndStatic() { return sizeof(StgIndStatic); } - -HsInt offset_StgIndStatic_indirectee() { - return offsetof(StgIndStatic, indirectee); +__attribute__((export_name("offset_StgBlockingQueue_link"))) uint32_t offset_StgBlockingQueue_link() { +return offsetof(StgBlockingQueue, link); } -HsInt offset_StgIndStatic_static_link() { - return offsetof(StgIndStatic, static_link); +__attribute__((export_name("offset_StgBlockingQueue_bh"))) uint32_t offset_StgBlockingQueue_bh() { +return offsetof(StgBlockingQueue, bh); } -HsInt offset_StgIndStatic_saved_info() { - return offsetof(StgIndStatic, saved_info); +__attribute__((export_name("offset_StgBlockingQueue_owner"))) uint32_t offset_StgBlockingQueue_owner() { +return offsetof(StgBlockingQueue, owner); } -HsInt offset_StgFunInfoExtraFwd_fun_type() { - return offsetof(StgFunInfoExtraFwd, fun_type); +__attribute__((export_name("offset_StgBlockingQueue_queue"))) uint32_t offset_StgBlockingQueue_queue() { +return offsetof(StgBlockingQueue, queue); } -HsInt offset_StgFunInfoExtraFwd_srt() { - return offsetof(StgFunInfoExtraFwd, srt); +__attribute__((export_name("sizeof_StgClosure"))) uint32_t sizeof_StgClosure() { return sizeof(StgClosure); } + +__attribute__((export_name("offset_StgClosure_payload"))) uint32_t offset_StgClosure_payload() { return offsetof(StgClosure, payload); } + +__attribute__((export_name("sizeof_StgInd"))) uint32_t sizeof_StgInd() { return sizeof(StgInd); } + +__attribute__((export_name("offset_StgInd_indirectee"))) uint32_t offset_StgInd_indirectee() { return offsetof(StgInd, indirectee); } + +__attribute__((export_name("sizeof_StgIndStatic"))) uint32_t sizeof_StgIndStatic() { return sizeof(StgIndStatic); } + +__attribute__((export_name("offset_StgIndStatic_indirectee"))) uint32_t offset_StgIndStatic_indirectee() { +return offsetof(StgIndStatic, indirectee); } -HsInt offset_StgFunInfoExtraFwd_b() { return offsetof(StgFunInfoExtraFwd, b); } - -HsInt offset_StgFunInfoTable_i() { return offsetof(StgFunInfoTable, i); } - -HsInt offset_StgFunInfoTable_f() { return offsetof(StgFunInfoTable, f); } - -HsInt sizeof_StgFunTable() { return sizeof(StgFunTable); } - -HsInt offset_StgFunTable_stgEagerBlackholeInfo() { - return offsetof(StgFunTable, stgEagerBlackholeInfo); +__attribute__((export_name("offset_StgIndStatic_static_link"))) uint32_t offset_StgIndStatic_static_link() { +return offsetof(StgIndStatic, static_link); } -HsInt offset_StgFunTable_stgGCEnter1() { - return offsetof(StgFunTable, stgGCEnter1); +__attribute__((export_name("offset_StgIndStatic_saved_info"))) uint32_t offset_StgIndStatic_saved_info() { +return offsetof(StgIndStatic, saved_info); } -HsInt offset_StgFunTable_stgGCFun() { return offsetof(StgFunTable, stgGCFun); } - -HsInt offset_StgInfoTable_entry() { return offsetof(StgInfoTable, entry); } - -HsInt offset_StgInfoTable_layout() { return offsetof(StgInfoTable, layout); } - -HsInt offset_StgInfoTable_type() { return offsetof(StgInfoTable, type); } - -HsInt offset_StgInfoTable_srt() { return offsetof(StgInfoTable, srt); } - -HsInt offset_StgLargeBitmap_size() { return offsetof(StgLargeBitmap, size); } - -HsInt offset_StgLargeBitmap_bitmap() { - return offsetof(StgLargeBitmap, bitmap); -} -HsInt sizeof_StgMutArrPtrs() { return sizeof(StgMutArrPtrs); } - -HsInt offset_StgMutArrPtrs_ptrs() { return offsetof(StgMutArrPtrs, ptrs); } - -HsInt offset_StgMutArrPtrs_size() { return offsetof(StgMutArrPtrs, size); } - -HsInt offset_StgMutArrPtrs_payload() { - return offsetof(StgMutArrPtrs, payload); +__attribute__((export_name("offset_StgFunInfoExtraFwd_fun_type"))) uint32_t offset_StgFunInfoExtraFwd_fun_type() { +return offsetof(StgFunInfoExtraFwd, fun_type); } -HsInt offset_StgMVar_head() { return offsetof(StgMVar, head); } - -HsInt offset_StgMVar_tail() { return offsetof(StgMVar, tail); } - -HsInt offset_StgMVar_value() { return offsetof(StgMVar, value); } - -HsInt sizeof_StgPAP() { return sizeof(StgPAP); } - -HsInt offset_StgPAP_arity() { return offsetof(StgPAP, arity); } - -HsInt offset_StgPAP_n_args() { return offsetof(StgPAP, n_args); } - -HsInt offset_StgPAP_fun() { return offsetof(StgPAP, fun); } - -HsInt offset_StgPAP_payload() { return offsetof(StgPAP, payload); } - -HsInt sizeof_StgRetFun() { return sizeof(StgRetFun); } - -HsInt offset_StgRetFun_size() { return offsetof(StgRetFun, size); } - -HsInt offset_StgRetFun_fun() { return offsetof(StgRetFun, fun); } - -HsInt offset_StgRetFun_payload() { return offsetof(StgRetFun, payload); } - -HsInt offset_StgRetInfoTable_i() { return offsetof(StgRetInfoTable, i); } - -HsInt offset_StgRetInfoTable_srt() { return offsetof(StgRetInfoTable, srt); } - -HsInt sizeof_StgRegTable() { return sizeof(StgRegTable); } - -HsInt offset_StgRegTable_rR1() { return offsetof(StgRegTable, rR1); } - -HsInt offset_StgRegTable_rR2() { return offsetof(StgRegTable, rR2); } - -HsInt offset_StgRegTable_rR3() { return offsetof(StgRegTable, rR3); } - -HsInt offset_StgRegTable_rR4() { return offsetof(StgRegTable, rR4); } - -HsInt offset_StgRegTable_rR5() { return offsetof(StgRegTable, rR5); } - -HsInt offset_StgRegTable_rR6() { return offsetof(StgRegTable, rR6); } - -HsInt offset_StgRegTable_rR7() { return offsetof(StgRegTable, rR7); } - -HsInt offset_StgRegTable_rR8() { return offsetof(StgRegTable, rR8); } - -HsInt offset_StgRegTable_rR9() { return offsetof(StgRegTable, rR9); } - -HsInt offset_StgRegTable_rR10() { return offsetof(StgRegTable, rR10); } - -HsInt offset_StgRegTable_rF1() { return offsetof(StgRegTable, rF1); } - -HsInt offset_StgRegTable_rF2() { return offsetof(StgRegTable, rF2); } - -HsInt offset_StgRegTable_rF3() { return offsetof(StgRegTable, rF3); } - -HsInt offset_StgRegTable_rF4() { return offsetof(StgRegTable, rF4); } - -HsInt offset_StgRegTable_rF5() { return offsetof(StgRegTable, rF5); } - -HsInt offset_StgRegTable_rF6() { return offsetof(StgRegTable, rF6); } - -HsInt offset_StgRegTable_rD1() { return offsetof(StgRegTable, rD1); } - -HsInt offset_StgRegTable_rD2() { return offsetof(StgRegTable, rD2); } - -HsInt offset_StgRegTable_rD3() { return offsetof(StgRegTable, rD3); } - -HsInt offset_StgRegTable_rD4() { return offsetof(StgRegTable, rD4); } - -HsInt offset_StgRegTable_rD5() { return offsetof(StgRegTable, rD5); } - -HsInt offset_StgRegTable_rD6() { return offsetof(StgRegTable, rD6); } - -HsInt offset_StgRegTable_rL1() { return offsetof(StgRegTable, rL1); } - -HsInt offset_StgRegTable_rSp() { return offsetof(StgRegTable, rSp); } - -HsInt offset_StgRegTable_rSpLim() { return offsetof(StgRegTable, rSpLim); } - -HsInt offset_StgRegTable_rHp() { return offsetof(StgRegTable, rHp); } - -HsInt offset_StgRegTable_rHpLim() { return offsetof(StgRegTable, rHpLim); } - -HsInt offset_StgRegTable_rCCCS() { return offsetof(StgRegTable, rCCCS); } - -HsInt offset_StgRegTable_rNursery() { return offsetof(StgRegTable, rNursery); } - -HsInt offset_StgRegTable_rCurrentTSO() { - return offsetof(StgRegTable, rCurrentTSO); +__attribute__((export_name("offset_StgFunInfoExtraFwd_srt"))) uint32_t offset_StgFunInfoExtraFwd_srt() { +return offsetof(StgFunInfoExtraFwd, srt); } -HsInt offset_StgRegTable_rCurrentNursery() { - return offsetof(StgRegTable, rCurrentNursery); +__attribute__((export_name("offset_StgFunInfoExtraFwd_b"))) uint32_t offset_StgFunInfoExtraFwd_b() { return offsetof(StgFunInfoExtraFwd, b); } + +__attribute__((export_name("offset_StgFunInfoTable_i"))) uint32_t offset_StgFunInfoTable_i() { return offsetof(StgFunInfoTable, i); } + +__attribute__((export_name("offset_StgFunInfoTable_f"))) uint32_t offset_StgFunInfoTable_f() { return offsetof(StgFunInfoTable, f); } + +__attribute__((export_name("sizeof_StgFunTable"))) uint32_t sizeof_StgFunTable() { return sizeof(StgFunTable); } + +__attribute__((export_name("offset_StgFunTable_stgEagerBlackholeInfo"))) uint32_t offset_StgFunTable_stgEagerBlackholeInfo() { +return offsetof(StgFunTable, stgEagerBlackholeInfo); } -HsInt offset_StgRegTable_rCurrentAlloc() { - return offsetof(StgRegTable, rCurrentAlloc); +__attribute__((export_name("offset_StgFunTable_stgGCEnter1"))) uint32_t offset_StgFunTable_stgGCEnter1() { +return offsetof(StgFunTable, stgGCEnter1); } -HsInt offset_StgRegTable_rHpAlloc() { return offsetof(StgRegTable, rHpAlloc); } +__attribute__((export_name("offset_StgFunTable_stgGCFun"))) uint32_t offset_StgFunTable_stgGCFun() { return offsetof(StgFunTable, stgGCFun); } -HsInt offset_StgRegTable_rRet() { return offsetof(StgRegTable, rRet); } +__attribute__((export_name("offset_StgInfoTable_entry"))) uint32_t offset_StgInfoTable_entry() { return offsetof(StgInfoTable, entry); } -HsInt sizeof_StgSelector() { return sizeof(StgSelector); } +__attribute__((export_name("offset_StgInfoTable_layout"))) uint32_t offset_StgInfoTable_layout() { return offsetof(StgInfoTable, layout); } -HsInt offset_StgSelector_selectee() { return offsetof(StgSelector, selectee); } +__attribute__((export_name("offset_StgInfoTable_type"))) uint32_t offset_StgInfoTable_type() { return offsetof(StgInfoTable, type); } -HsInt sizeof_StgSmallMutArrPtrs() { return sizeof(StgSmallMutArrPtrs); } +__attribute__((export_name("offset_StgInfoTable_srt"))) uint32_t offset_StgInfoTable_srt() { return offsetof(StgInfoTable, srt); } -HsInt offset_StgSmallMutArrPtrs_ptrs() { - return offsetof(StgSmallMutArrPtrs, ptrs); +__attribute__((export_name("offset_StgLargeBitmap_size"))) uint32_t offset_StgLargeBitmap_size() { return offsetof(StgLargeBitmap, size); } + +__attribute__((export_name("offset_StgLargeBitmap_bitmap"))) uint32_t offset_StgLargeBitmap_bitmap() { +return offsetof(StgLargeBitmap, bitmap); } -HsInt offset_StgSmallMutArrPtrs_payload() { - return offsetof(StgSmallMutArrPtrs, payload); +__attribute__((export_name("sizeof_StgMutArrPtrs"))) uint32_t sizeof_StgMutArrPtrs() { return sizeof(StgMutArrPtrs); } + +__attribute__((export_name("offset_StgMutArrPtrs_ptrs"))) uint32_t offset_StgMutArrPtrs_ptrs() { return offsetof(StgMutArrPtrs, ptrs); } + +__attribute__((export_name("offset_StgMutArrPtrs_size"))) uint32_t offset_StgMutArrPtrs_size() { return offsetof(StgMutArrPtrs, size); } + +__attribute__((export_name("offset_StgMutArrPtrs_payload"))) uint32_t offset_StgMutArrPtrs_payload() { +return offsetof(StgMutArrPtrs, payload); } -HsInt sizeof_StgStack() { return sizeof(StgStack); } +__attribute__((export_name("offset_StgMVar_head"))) uint32_t offset_StgMVar_head() { return offsetof(StgMVar, head); } -HsInt offset_StgStack_stack_size() { return offsetof(StgStack, stack_size); } +__attribute__((export_name("offset_StgMVar_tail"))) uint32_t offset_StgMVar_tail() { return offsetof(StgMVar, tail); } -HsInt offset_StgStack_dirty() { return offsetof(StgStack, dirty); } +__attribute__((export_name("offset_StgMVar_value"))) uint32_t offset_StgMVar_value() { return offsetof(StgMVar, value); } -HsInt offset_StgStack_sp() { return offsetof(StgStack, sp); } +__attribute__((export_name("sizeof_StgPAP"))) uint32_t sizeof_StgPAP() { return sizeof(StgPAP); } -HsInt offset_StgStack_stack() { - return 8 * ROUNDUP_BYTES_TO_WDS(sizeof(StgStack)); +__attribute__((export_name("offset_StgPAP_arity"))) uint32_t offset_StgPAP_arity() { return offsetof(StgPAP, arity); } + +__attribute__((export_name("offset_StgPAP_n_args"))) uint32_t offset_StgPAP_n_args() { return offsetof(StgPAP, n_args); } + +__attribute__((export_name("offset_StgPAP_fun"))) uint32_t offset_StgPAP_fun() { return offsetof(StgPAP, fun); } + +__attribute__((export_name("offset_StgPAP_payload"))) uint32_t offset_StgPAP_payload() { return offsetof(StgPAP, payload); } + +__attribute__((export_name("sizeof_StgRetFun"))) uint32_t sizeof_StgRetFun() { return sizeof(StgRetFun); } + +__attribute__((export_name("offset_StgRetFun_size"))) uint32_t offset_StgRetFun_size() { return offsetof(StgRetFun, size); } + +__attribute__((export_name("offset_StgRetFun_fun"))) uint32_t offset_StgRetFun_fun() { return offsetof(StgRetFun, fun); } + +__attribute__((export_name("offset_StgRetFun_payload"))) uint32_t offset_StgRetFun_payload() { return offsetof(StgRetFun, payload); } + +__attribute__((export_name("offset_StgRetInfoTable_i"))) uint32_t offset_StgRetInfoTable_i() { return offsetof(StgRetInfoTable, i); } + +__attribute__((export_name("offset_StgRetInfoTable_srt"))) uint32_t offset_StgRetInfoTable_srt() { return offsetof(StgRetInfoTable, srt); } + +__attribute__((export_name("sizeof_StgRegTable"))) uint32_t sizeof_StgRegTable() { return sizeof(StgRegTable); } + +__attribute__((export_name("offset_StgRegTable_rR1"))) uint32_t offset_StgRegTable_rR1() { return offsetof(StgRegTable, rR1); } + +__attribute__((export_name("offset_StgRegTable_rR2"))) uint32_t offset_StgRegTable_rR2() { return offsetof(StgRegTable, rR2); } + +__attribute__((export_name("offset_StgRegTable_rR3"))) uint32_t offset_StgRegTable_rR3() { return offsetof(StgRegTable, rR3); } + +__attribute__((export_name("offset_StgRegTable_rR4"))) uint32_t offset_StgRegTable_rR4() { return offsetof(StgRegTable, rR4); } + +__attribute__((export_name("offset_StgRegTable_rR5"))) uint32_t offset_StgRegTable_rR5() { return offsetof(StgRegTable, rR5); } + +__attribute__((export_name("offset_StgRegTable_rR6"))) uint32_t offset_StgRegTable_rR6() { return offsetof(StgRegTable, rR6); } + +__attribute__((export_name("offset_StgRegTable_rR7"))) uint32_t offset_StgRegTable_rR7() { return offsetof(StgRegTable, rR7); } + +__attribute__((export_name("offset_StgRegTable_rR8"))) uint32_t offset_StgRegTable_rR8() { return offsetof(StgRegTable, rR8); } + +__attribute__((export_name("offset_StgRegTable_rR9"))) uint32_t offset_StgRegTable_rR9() { return offsetof(StgRegTable, rR9); } + +__attribute__((export_name("offset_StgRegTable_rR10"))) uint32_t offset_StgRegTable_rR10() { return offsetof(StgRegTable, rR10); } + +__attribute__((export_name("offset_StgRegTable_rF1"))) uint32_t offset_StgRegTable_rF1() { return offsetof(StgRegTable, rF1); } + +__attribute__((export_name("offset_StgRegTable_rF2"))) uint32_t offset_StgRegTable_rF2() { return offsetof(StgRegTable, rF2); } + +__attribute__((export_name("offset_StgRegTable_rF3"))) uint32_t offset_StgRegTable_rF3() { return offsetof(StgRegTable, rF3); } + +__attribute__((export_name("offset_StgRegTable_rF4"))) uint32_t offset_StgRegTable_rF4() { return offsetof(StgRegTable, rF4); } + +__attribute__((export_name("offset_StgRegTable_rF5"))) uint32_t offset_StgRegTable_rF5() { return offsetof(StgRegTable, rF5); } + +__attribute__((export_name("offset_StgRegTable_rF6"))) uint32_t offset_StgRegTable_rF6() { return offsetof(StgRegTable, rF6); } + +__attribute__((export_name("offset_StgRegTable_rD1"))) uint32_t offset_StgRegTable_rD1() { return offsetof(StgRegTable, rD1); } + +__attribute__((export_name("offset_StgRegTable_rD2"))) uint32_t offset_StgRegTable_rD2() { return offsetof(StgRegTable, rD2); } + +__attribute__((export_name("offset_StgRegTable_rD3"))) uint32_t offset_StgRegTable_rD3() { return offsetof(StgRegTable, rD3); } + +__attribute__((export_name("offset_StgRegTable_rD4"))) uint32_t offset_StgRegTable_rD4() { return offsetof(StgRegTable, rD4); } + +__attribute__((export_name("offset_StgRegTable_rD5"))) uint32_t offset_StgRegTable_rD5() { return offsetof(StgRegTable, rD5); } + +__attribute__((export_name("offset_StgRegTable_rD6"))) uint32_t offset_StgRegTable_rD6() { return offsetof(StgRegTable, rD6); } + +__attribute__((export_name("offset_StgRegTable_rL1"))) uint32_t offset_StgRegTable_rL1() { return offsetof(StgRegTable, rL1); } + +__attribute__((export_name("offset_StgRegTable_rSp"))) uint32_t offset_StgRegTable_rSp() { return offsetof(StgRegTable, rSp); } + +__attribute__((export_name("offset_StgRegTable_rSpLim"))) uint32_t offset_StgRegTable_rSpLim() { return offsetof(StgRegTable, rSpLim); } + +__attribute__((export_name("offset_StgRegTable_rHp"))) uint32_t offset_StgRegTable_rHp() { return offsetof(StgRegTable, rHp); } + +__attribute__((export_name("offset_StgRegTable_rHpLim"))) uint32_t offset_StgRegTable_rHpLim() { return offsetof(StgRegTable, rHpLim); } + +__attribute__((export_name("offset_StgRegTable_rCCCS"))) uint32_t offset_StgRegTable_rCCCS() { return offsetof(StgRegTable, rCCCS); } + +__attribute__((export_name("offset_StgRegTable_rNursery"))) uint32_t offset_StgRegTable_rNursery() { return offsetof(StgRegTable, rNursery); } + +__attribute__((export_name("offset_StgRegTable_rCurrentTSO"))) uint32_t offset_StgRegTable_rCurrentTSO() { +return offsetof(StgRegTable, rCurrentTSO); } -HsInt sizeof_StgStopFrame() { return sizeof(StgStopFrame); } - -HsInt sizeof_StgThunk() { return sizeof(StgThunk); } - -HsInt offset_StgThunk_payload() { return offsetof(StgThunk, payload); } - -HsInt offset_StgThunkInfoTable_i() { return offsetof(StgThunkInfoTable, i); } - -HsInt offset_StgThunkInfoTable_srt() { - return offsetof(StgThunkInfoTable, srt); +__attribute__((export_name("offset_StgRegTable_rCurrentNursery"))) uint32_t offset_StgRegTable_rCurrentNursery() { +return offsetof(StgRegTable, rCurrentNursery); } -HsInt sizeof_StgTSO() { return sizeof(StgTSO); } - -HsInt offset_StgTSO__link() { return offsetof(StgTSO, _link); } - -HsInt offset_StgTSO_stackobj() { return offsetof(StgTSO, stackobj); } - -HsInt offset_StgTSO_what_next() { return offsetof(StgTSO, what_next); } - -HsInt offset_StgTSO_why_blocked() { return offsetof(StgTSO, why_blocked); } - -HsInt offset_StgTSO_flags() { return offsetof(StgTSO, flags); } - -HsInt offset_StgTSO_block_info() { return offsetof(StgTSO, block_info); } - -HsInt offset_StgTSO_id() { return offsetof(StgTSO, id); } - -HsInt offset_StgTSO_saved_errno() { return offsetof(StgTSO, saved_errno); } - -HsInt offset_StgTSO_dirty() { return offsetof(StgTSO, dirty); } - -HsInt offset_StgTSO_bound() { return offsetof(StgTSO, bound); } - -HsInt offset_StgTSO_cap() { return offsetof(StgTSO, cap); } - -HsInt offset_StgTSO_trec() { return offsetof(StgTSO, trec); } - -HsInt offset_StgTSO_blocked_exceptions() { - return offsetof(StgTSO, blocked_exceptions); +__attribute__((export_name("offset_StgRegTable_rCurrentAlloc"))) uint32_t offset_StgRegTable_rCurrentAlloc() { +return offsetof(StgRegTable, rCurrentAlloc); } -HsInt offset_StgTSO_bq() { return offsetof(StgTSO, bq); } +__attribute__((export_name("offset_StgRegTable_rHpAlloc"))) uint32_t offset_StgRegTable_rHpAlloc() { return offsetof(StgRegTable, rHpAlloc); } -HsInt offset_StgTSO_alloc_limit() { return offsetof(StgTSO, alloc_limit); } +__attribute__((export_name("offset_StgRegTable_rRet"))) uint32_t offset_StgRegTable_rRet() { return offsetof(StgRegTable, rRet); } -HsInt offset_StgTSO_tot_stack_size() { - return offsetof(StgTSO, tot_stack_size); +__attribute__((export_name("sizeof_StgSelector"))) uint32_t sizeof_StgSelector() { return sizeof(StgSelector); } + +__attribute__((export_name("offset_StgSelector_selectee"))) uint32_t offset_StgSelector_selectee() { return offsetof(StgSelector, selectee); } + +__attribute__((export_name("sizeof_StgSmallMutArrPtrs"))) uint32_t sizeof_StgSmallMutArrPtrs() { return sizeof(StgSmallMutArrPtrs); } + +__attribute__((export_name("offset_StgSmallMutArrPtrs_ptrs"))) uint32_t offset_StgSmallMutArrPtrs_ptrs() { +return offsetof(StgSmallMutArrPtrs, ptrs); } -HsInt offset_StgUpdateFrame_updatee() { - return offsetof(StgUpdateFrame, updatee); +__attribute__((export_name("offset_StgSmallMutArrPtrs_payload"))) uint32_t offset_StgSmallMutArrPtrs_payload() { +return offsetof(StgSmallMutArrPtrs, payload); } -HsInt sizeof_StgWeak() { return sizeof(StgWeak); } +__attribute__((export_name("sizeof_StgStack"))) uint32_t sizeof_StgStack() { return sizeof(StgStack); } -HsInt offset_StgWeak_cfinalizers() { return offsetof(StgWeak, cfinalizers); } +__attribute__((export_name("offset_StgStack_stack_size"))) uint32_t offset_StgStack_stack_size() { return offsetof(StgStack, stack_size); } -HsInt offset_StgWeak_key() { return offsetof(StgWeak, key); } +__attribute__((export_name("offset_StgStack_dirty"))) uint32_t offset_StgStack_dirty() { return offsetof(StgStack, dirty); } -HsInt offset_StgWeak_value() { return offsetof(StgWeak, value); } +__attribute__((export_name("offset_StgStack_sp"))) uint32_t offset_StgStack_sp() { return offsetof(StgStack, sp); } -HsInt offset_StgWeak_finalizer() { return offsetof(StgWeak, finalizer); } - -HsInt offset_StgWeak_link() { return offsetof(StgWeak, link); } - -HsInt next_ThreadRunGHC() { return ThreadRunGHC; } - -HsInt next_ThreadInterpret() { return ThreadInterpret; } - -HsInt next_ThreadKilled() { return ThreadKilled; } - -HsInt next_ThreadComplete() { return ThreadComplete; } - -HsInt bf_EVACUATED() { return BF_EVACUATED; } - -HsInt bf_LARGE() { return BF_LARGE; } - -HsInt bf_PINNED() { return BF_PINNED; } - -HsInt bf_MARKED() { return BF_MARKED; } - -HsInt bf_EXEC() { return BF_EXEC; } - -HsInt bf_FRAGMENTED() { return BF_FRAGMENTED; } - -HsInt bf_KNOWN() { return BF_KNOWN; } - -HsInt bf_SWEPT() { return BF_SWEPT; } - -HsInt bf_COMPACT() { return BF_COMPACT; } - -HsInt blocked_NotBlocked() { return NotBlocked; } - -HsInt blocked_BlockedOnMVar() { return BlockedOnMVar; } - -HsInt blocked_BlockedOnMVarRead() { return BlockedOnMVarRead; } - -HsInt blocked_BlockedOnBlackHole() { return BlockedOnBlackHole; } - -HsInt blocked_BlockedOnRead() { return BlockedOnRead; } - -HsInt blocked_BlockedOnWrite() { return BlockedOnWrite; } - -HsInt blocked_BlockedOnDelay() { return BlockedOnDelay; } - -HsInt blocked_BlockedOnSTM() { return BlockedOnSTM; } - -HsInt blocked_BlockedOnDoProc() { return BlockedOnDoProc; } - -HsInt blocked_BlockedOnCCall() { return BlockedOnCCall; } - -HsInt blocked_BlockedOnCCall_Interruptible() { - return BlockedOnCCall_Interruptible; +__attribute__((export_name("offset_StgStack_stack"))) uint32_t offset_StgStack_stack() { +return 4 * ROUNDUP_BYTES_TO_WDS(sizeof(StgStack)); } -HsInt blocked_BlockedOnMsgThrowTo() { return BlockedOnMsgThrowTo; } +__attribute__((export_name("sizeof_StgStopFrame"))) uint32_t sizeof_StgStopFrame() { return sizeof(StgStopFrame); } -HsInt blocked_ThreadMigrating() { return ThreadMigrating; } +__attribute__((export_name("sizeof_StgThunk"))) uint32_t sizeof_StgThunk() { return sizeof(StgThunk); } -HsInt ret_HeapOverflow() { return HeapOverflow; } +__attribute__((export_name("offset_StgThunk_payload"))) uint32_t offset_StgThunk_payload() { return offsetof(StgThunk, payload); } -HsInt ret_StackOverflow() { return StackOverflow; } +__attribute__((export_name("offset_StgThunkInfoTable_i"))) uint32_t offset_StgThunkInfoTable_i() { return offsetof(StgThunkInfoTable, i); } -HsInt ret_ThreadYielding() { return ThreadYielding; } +__attribute__((export_name("offset_StgThunkInfoTable_srt"))) uint32_t offset_StgThunkInfoTable_srt() { +return offsetof(StgThunkInfoTable, srt); +} -HsInt ret_ThreadBlocked() { return ThreadBlocked; } +__attribute__((export_name("sizeof_StgTSO"))) uint32_t sizeof_StgTSO() { return sizeof(StgTSO); } -HsInt ret_ThreadFinished() { return ThreadFinished; } +__attribute__((export_name("offset_StgTSO__link"))) uint32_t offset_StgTSO__link() { return offsetof(StgTSO, _link); } -HsInt sched_SCHED_RUNNING() { return SCHED_RUNNING; } +__attribute__((export_name("offset_StgTSO_stackobj"))) uint32_t offset_StgTSO_stackobj() { return offsetof(StgTSO, stackobj); } -HsInt sched_SCHED_INTERRUPTING() { return SCHED_INTERRUPTING; } +__attribute__((export_name("offset_StgTSO_what_next"))) uint32_t offset_StgTSO_what_next() { return offsetof(StgTSO, what_next); } -HsInt sched_SCHED_SHUTTING_DOWN() { return SCHED_SHUTTING_DOWN; } +__attribute__((export_name("offset_StgTSO_why_blocked"))) uint32_t offset_StgTSO_why_blocked() { return offsetof(StgTSO, why_blocked); } -HsInt scheduler_NoStatus() { return NoStatus; } +__attribute__((export_name("offset_StgTSO_flags"))) uint32_t offset_StgTSO_flags() { return offsetof(StgTSO, flags); } -HsInt scheduler_Success() { return Success; } +__attribute__((export_name("offset_StgTSO_block_info"))) uint32_t offset_StgTSO_block_info() { return offsetof(StgTSO, block_info); } -HsInt scheduler_Killed() { return Killed; } +__attribute__((export_name("offset_StgTSO_id"))) uint32_t offset_StgTSO_id() { return offsetof(StgTSO, id); } -HsInt scheduler_Interrupted() { return Interrupted; } +__attribute__((export_name("offset_StgTSO_saved_errno"))) uint32_t offset_StgTSO_saved_errno() { return offsetof(StgTSO, saved_errno); } -HsInt scheduler_HeapExhausted() { return HeapExhausted; } +__attribute__((export_name("offset_StgTSO_dirty"))) uint32_t offset_StgTSO_dirty() { return offsetof(StgTSO, dirty); } -HsInt sizeof_bool() { return sizeof(bool); } +__attribute__((export_name("offset_StgTSO_bound"))) uint32_t offset_StgTSO_bound() { return offsetof(StgTSO, bound); } -HsInt sizeof_int() { return sizeof(int); } +__attribute__((export_name("offset_StgTSO_cap"))) uint32_t offset_StgTSO_cap() { return offsetof(StgTSO, cap); } -HsInt sizeof_SchedulerStatus() { return sizeof(SchedulerStatus); } +__attribute__((export_name("offset_StgTSO_trec"))) uint32_t offset_StgTSO_trec() { return offsetof(StgTSO, trec); } -HsInt tso_LOCKED() { return TSO_LOCKED; } +__attribute__((export_name("offset_StgTSO_blocked_exceptions"))) uint32_t offset_StgTSO_blocked_exceptions() { +return offsetof(StgTSO, blocked_exceptions); +} -HsInt tso_BLOCKEX() { return TSO_BLOCKEX; } +__attribute__((export_name("offset_StgTSO_bq"))) uint32_t offset_StgTSO_bq() { return offsetof(StgTSO, bq); } -HsInt tso_INTERRUPTIBLE() { return TSO_INTERRUPTIBLE; } +__attribute__((export_name("offset_StgTSO_alloc_limit"))) uint32_t offset_StgTSO_alloc_limit() { return offsetof(StgTSO, alloc_limit); } -HsInt tso_STOPPED_ON_BREAKPOINT() { return TSO_STOPPED_ON_BREAKPOINT; } +__attribute__((export_name("offset_StgTSO_tot_stack_size"))) uint32_t offset_StgTSO_tot_stack_size() { +return offsetof(StgTSO, tot_stack_size); +} -HsInt tso_MARKED() { return TSO_MARKED; } +__attribute__((export_name("offset_StgUpdateFrame_updatee"))) uint32_t offset_StgUpdateFrame_updatee() { +return offsetof(StgUpdateFrame, updatee); +} -HsInt tso_SQUEEZED() { return TSO_SQUEEZED; } +__attribute__((export_name("sizeof_StgWeak"))) uint32_t sizeof_StgWeak() { return sizeof(StgWeak); } -HsInt tso_ALLOC_LIMIT() { return TSO_ALLOC_LIMIT; } +__attribute__((export_name("offset_StgWeak_cfinalizers"))) uint32_t offset_StgWeak_cfinalizers() { return offsetof(StgWeak, cfinalizers); } -HsInt sizeof_StgStableName() { return sizeof(StgStableName); } +__attribute__((export_name("offset_StgWeak_key"))) uint32_t offset_StgWeak_key() { return offsetof(StgWeak, key); } -HsInt offset_StgStableName_header() { return offsetof(StgStableName, header); } +__attribute__((export_name("offset_StgWeak_value"))) uint32_t offset_StgWeak_value() { return offsetof(StgWeak, value); } -HsInt offset_StgStableName_sn() { return offsetof(StgStableName, sn); } +__attribute__((export_name("offset_StgWeak_finalizer"))) uint32_t offset_StgWeak_finalizer() { return offsetof(StgWeak, finalizer); } -HsInt clock_monotonic() { return CLOCK_MONOTONIC; } +__attribute__((export_name("offset_StgWeak_link"))) uint32_t offset_StgWeak_link() { return offsetof(StgWeak, link); } -HsInt clock_realtime() { return CLOCK_REALTIME; } +__attribute__((export_name("next_ThreadRunGHC"))) uint32_t next_ThreadRunGHC() { return ThreadRunGHC; } + +__attribute__((export_name("next_ThreadInterpret"))) uint32_t next_ThreadInterpret() { return ThreadInterpret; } + +__attribute__((export_name("next_ThreadKilled"))) uint32_t next_ThreadKilled() { return ThreadKilled; } + +__attribute__((export_name("next_ThreadComplete"))) uint32_t next_ThreadComplete() { return ThreadComplete; } + +__attribute__((export_name("bf_EVACUATED"))) uint32_t bf_EVACUATED() { return BF_EVACUATED; } + +__attribute__((export_name("bf_LARGE"))) uint32_t bf_LARGE() { return BF_LARGE; } + +__attribute__((export_name("bf_PINNED"))) uint32_t bf_PINNED() { return BF_PINNED; } + +__attribute__((export_name("bf_MARKED"))) uint32_t bf_MARKED() { return BF_MARKED; } + +__attribute__((export_name("bf_EXEC"))) uint32_t bf_EXEC() { return BF_EXEC; } + +__attribute__((export_name("bf_FRAGMENTED"))) uint32_t bf_FRAGMENTED() { return BF_FRAGMENTED; } + +__attribute__((export_name("bf_KNOWN"))) uint32_t bf_KNOWN() { return BF_KNOWN; } + +__attribute__((export_name("bf_SWEPT"))) uint32_t bf_SWEPT() { return BF_SWEPT; } + +__attribute__((export_name("bf_COMPACT"))) uint32_t bf_COMPACT() { return BF_COMPACT; } + +__attribute__((export_name("blocked_NotBlocked"))) uint32_t blocked_NotBlocked() { return NotBlocked; } + +__attribute__((export_name("blocked_BlockedOnMVar"))) uint32_t blocked_BlockedOnMVar() { return BlockedOnMVar; } + +__attribute__((export_name("blocked_BlockedOnMVarRead"))) uint32_t blocked_BlockedOnMVarRead() { return BlockedOnMVarRead; } + +__attribute__((export_name("blocked_BlockedOnBlackHole"))) uint32_t blocked_BlockedOnBlackHole() { return BlockedOnBlackHole; } + +__attribute__((export_name("blocked_BlockedOnRead"))) uint32_t blocked_BlockedOnRead() { return BlockedOnRead; } + +__attribute__((export_name("blocked_BlockedOnWrite"))) uint32_t blocked_BlockedOnWrite() { return BlockedOnWrite; } + +__attribute__((export_name("blocked_BlockedOnDelay"))) uint32_t blocked_BlockedOnDelay() { return BlockedOnDelay; } + +__attribute__((export_name("blocked_BlockedOnSTM"))) uint32_t blocked_BlockedOnSTM() { return BlockedOnSTM; } + +__attribute__((export_name("blocked_BlockedOnDoProc"))) uint32_t blocked_BlockedOnDoProc() { return BlockedOnDoProc; } + +__attribute__((export_name("blocked_BlockedOnCCall"))) uint32_t blocked_BlockedOnCCall() { return BlockedOnCCall; } + +__attribute__((export_name("blocked_BlockedOnCCall_Interruptible"))) uint32_t blocked_BlockedOnCCall_Interruptible() { +return BlockedOnCCall_Interruptible; +} + +__attribute__((export_name("blocked_BlockedOnMsgThrowTo"))) uint32_t blocked_BlockedOnMsgThrowTo() { return BlockedOnMsgThrowTo; } + +__attribute__((export_name("blocked_ThreadMigrating"))) uint32_t blocked_ThreadMigrating() { return ThreadMigrating; } + +__attribute__((export_name("ret_HeapOverflow"))) uint32_t ret_HeapOverflow() { return HeapOverflow; } + +__attribute__((export_name("ret_StackOverflow"))) uint32_t ret_StackOverflow() { return StackOverflow; } + +__attribute__((export_name("ret_ThreadYielding"))) uint32_t ret_ThreadYielding() { return ThreadYielding; } + +__attribute__((export_name("ret_ThreadBlocked"))) uint32_t ret_ThreadBlocked() { return ThreadBlocked; } + +__attribute__((export_name("ret_ThreadFinished"))) uint32_t ret_ThreadFinished() { return ThreadFinished; } + +__attribute__((export_name("sched_SCHED_RUNNING"))) uint32_t sched_SCHED_RUNNING() { return SCHED_RUNNING; } + +__attribute__((export_name("sched_SCHED_INTERRUPTING"))) uint32_t sched_SCHED_INTERRUPTING() { return SCHED_INTERRUPTING; } + +__attribute__((export_name("sched_SCHED_SHUTTING_DOWN"))) uint32_t sched_SCHED_SHUTTING_DOWN() { return SCHED_SHUTTING_DOWN; } + +__attribute__((export_name("scheduler_NoStatus"))) uint32_t scheduler_NoStatus() { return NoStatus; } + +__attribute__((export_name("scheduler_Success"))) uint32_t scheduler_Success() { return Success; } + +__attribute__((export_name("scheduler_Killed"))) uint32_t scheduler_Killed() { return Killed; } + +__attribute__((export_name("scheduler_Interrupted"))) uint32_t scheduler_Interrupted() { return Interrupted; } + +__attribute__((export_name("scheduler_HeapExhausted"))) uint32_t scheduler_HeapExhausted() { return HeapExhausted; } + +__attribute__((export_name("sizeof_bool"))) uint32_t sizeof_bool() { return sizeof(bool); } + +__attribute__((export_name("sizeof_int"))) uint32_t sizeof_int() { return sizeof(int); } + +__attribute__((export_name("sizeof_SchedulerStatus"))) uint32_t sizeof_SchedulerStatus() { return sizeof(SchedulerStatus); } + +__attribute__((export_name("tso_LOCKED"))) uint32_t tso_LOCKED() { return TSO_LOCKED; } + +__attribute__((export_name("tso_BLOCKEX"))) uint32_t tso_BLOCKEX() { return TSO_BLOCKEX; } + +__attribute__((export_name("tso_INTERRUPTIBLE"))) uint32_t tso_INTERRUPTIBLE() { return TSO_INTERRUPTIBLE; } + +__attribute__((export_name("tso_STOPPED_ON_BREAKPOINT"))) uint32_t tso_STOPPED_ON_BREAKPOINT() { return TSO_STOPPED_ON_BREAKPOINT; } + +__attribute__((export_name("tso_MARKED"))) uint32_t tso_MARKED() { return TSO_MARKED; } + +__attribute__((export_name("tso_SQUEEZED"))) uint32_t tso_SQUEEZED() { return TSO_SQUEEZED; } + +__attribute__((export_name("tso_ALLOC_LIMIT"))) uint32_t tso_ALLOC_LIMIT() { return TSO_ALLOC_LIMIT; } + +__attribute__((export_name("sizeof_StgStableName"))) uint32_t sizeof_StgStableName() { return sizeof(StgStableName); } + +__attribute__((export_name("offset_StgStableName_header"))) uint32_t offset_StgStableName_header() { return offsetof(StgStableName, header); } + +__attribute__((export_name("offset_StgStableName_sn"))) uint32_t offset_StgStableName_sn() { return offsetof(StgStableName, sn); } + +__attribute__((export_name("clock_monotonic"))) uint32_t clock_monotonic() { return CLOCK_MONOTONIC; } + +__attribute__((export_name("clock_realtime"))) uint32_t clock_realtime() { return CLOCK_REALTIME; } diff --git a/ghc-toolkit/package.yaml b/ghc-toolkit/package.yaml index 81c0178e..51e64d15 100644 --- a/ghc-toolkit/package.yaml +++ b/ghc-toolkit/package.yaml @@ -24,7 +24,6 @@ dependencies: - process library: - extra-libraries: ghcconstants source-dirs: src other-extensions: - DuplicateRecordFields diff --git a/ghc-toolkit/src/Language/Haskell/GHC/Toolkit/Constants.hs b/ghc-toolkit/src/Language/Haskell/GHC/Toolkit/Constants.hs index be3cae70..e5affaa7 100644 --- a/ghc-toolkit/src/Language/Haskell/GHC/Toolkit/Constants.hs +++ b/ghc-toolkit/src/Language/Haskell/GHC/Toolkit/Constants.hs @@ -1,600 +1,1115 @@ module Language.Haskell.GHC.Toolkit.Constants where -foreign import ccall unsafe "offset_timespec_tv_sec" - offset_timespec_tv_sec :: - Int - -foreign import ccall unsafe "offset_timespec_tv_nsec" - offset_timespec_tv_nsec :: - Int - -foreign import ccall unsafe "roundup" roundup :: Int -> Int -> Int - -foreign import ccall unsafe "roundup_bytes_to_words" - roundup_bytes_to_words :: Int -> Int - -foreign import ccall unsafe "block_size" block_size :: Int - -foreign import ccall unsafe "mblock_size" mblock_size :: Int - -foreign import ccall unsafe "blocks_per_mblock" blocks_per_mblock :: Int - -foreign import ccall unsafe "offset_first_bdescr" offset_first_bdescr :: Int - -foreign import ccall unsafe "offset_last_bdescr" offset_last_bdescr :: Int - -foreign import ccall unsafe "offset_first_block" offset_first_block :: Int - -foreign import ccall unsafe "offset_last_block" offset_last_block :: Int - -foreign import ccall unsafe "sizeof_bdescr" sizeof_bdescr :: Int - -foreign import ccall unsafe "offset_bdescr_start" offset_bdescr_start :: Int - -foreign import ccall unsafe "offset_bdescr_free" offset_bdescr_free :: Int - -foreign import ccall unsafe "offset_bdescr_link" offset_bdescr_link :: Int - -foreign import ccall unsafe "offset_bdescr_gen_no" offset_bdescr_gen_no :: Int - -foreign import ccall unsafe "offset_bdescr_node" offset_bdescr_node :: Int - -foreign import ccall unsafe "offset_bdescr_flags" offset_bdescr_flags :: Int - -foreign import ccall unsafe "offset_bdescr_blocks" offset_bdescr_blocks :: Int - -foreign import ccall unsafe "sizeof_Capability" sizeof_Capability :: Int - -foreign import ccall unsafe "offset_Capability_f" offset_Capability_f :: Int - -foreign import ccall unsafe "offset_Capability_r" offset_Capability_r :: Int - -foreign import ccall unsafe "offset_Capability_no" offset_Capability_no :: Int - -foreign import ccall unsafe "offset_Capability_node" - offset_Capability_node :: Int - -foreign import ccall unsafe "offset_Capability_running_task" - offset_Capability_running_task :: Int - -foreign import ccall unsafe "offset_Capability_in_haskell" - offset_Capability_in_haskell :: Int - -foreign import ccall unsafe "offset_Capability_idle" - offset_Capability_idle :: Int - -foreign import ccall unsafe "offset_Capability_disabled" - offset_Capability_disabled :: Int - -foreign import ccall unsafe "offset_Capability_run_queue_hd" - offset_Capability_run_queue_hd :: Int - -foreign import ccall unsafe "offset_Capability_run_queue_tl" - offset_Capability_run_queue_tl :: Int - -foreign import ccall unsafe "offset_Capability_n_run_queue" - offset_Capability_n_run_queue :: Int - -foreign import ccall unsafe "offset_Capability_suspended_ccalls" - offset_Capability_suspended_ccalls :: Int - -foreign import ccall unsafe "offset_Capability_n_suspended_ccalls" - offset_Capability_n_suspended_ccalls :: Int - -foreign import ccall unsafe "offset_Capability_mut_lists" - offset_Capability_mut_lists :: Int - -foreign import ccall unsafe "offset_Capability_saved_mut_lists" - offset_Capability_saved_mut_lists :: Int - -foreign import ccall unsafe "offset_Capability_pinned_object_block" - offset_Capability_pinned_object_block :: Int - -foreign import ccall unsafe "offset_Capability_pinned_object_blocks" - offset_Capability_pinned_object_blocks :: Int - -foreign import ccall unsafe "offset_Capability_weak_ptr_list_hd" - offset_Capability_weak_ptr_list_hd :: Int - -foreign import ccall unsafe "offset_Capability_weak_ptr_list_tl" - offset_Capability_weak_ptr_list_tl :: Int - -foreign import ccall unsafe "offset_Capability_context_switch" - offset_Capability_context_switch :: Int - -foreign import ccall unsafe "offset_Capability_interrupt" - offset_Capability_interrupt :: Int - -foreign import ccall unsafe "offset_Capability_total_allocated" - offset_Capability_total_allocated :: Int - -foreign import ccall unsafe "offset_Capability_free_tvar_watch_queues" - offset_Capability_free_tvar_watch_queues :: Int - -foreign import ccall unsafe "offset_Capability_free_trec_chunks" - offset_Capability_free_trec_chunks :: Int - -foreign import ccall unsafe "offset_Capability_free_trec_headers" - offset_Capability_free_trec_headers :: Int - -foreign import ccall unsafe "offset_Capability_transaction_tokens" - offset_Capability_transaction_tokens :: Int - -foreign import ccall unsafe "sizeof_MessageBlackHole" sizeof_MessageBlackHole :: Int - -foreign import ccall unsafe "offset_MessageBlackHole_link" offset_MessageBlackHole_link :: Int - -foreign import ccall unsafe "offset_MessageBlackHole_tso" offset_MessageBlackHole_tso :: Int - -foreign import ccall unsafe "offset_MessageBlackHole_bh" offset_MessageBlackHole_bh :: Int - -foreign import ccall unsafe "sizeof_StgAP" sizeof_StgAP :: Int - -foreign import ccall unsafe "offset_StgAP_arity" offset_StgAP_arity :: Int - -foreign import ccall unsafe "offset_StgAP_n_args" offset_StgAP_n_args :: Int - -foreign import ccall unsafe "offset_StgAP_fun" offset_StgAP_fun :: Int - -foreign import ccall unsafe "offset_StgAP_payload" offset_StgAP_payload :: Int - -foreign import ccall unsafe "sizeof_StgAP_STACK" sizeof_StgAP_STACK :: Int - -foreign import ccall unsafe "offset_StgAP_STACK_size" - offset_StgAP_STACK_size :: Int - -foreign import ccall unsafe "offset_StgAP_STACK_fun" - offset_StgAP_STACK_fun :: Int - -foreign import ccall unsafe "offset_StgAP_STACK_payload" - offset_StgAP_STACK_payload :: Int - -foreign import ccall unsafe "sizeof_StgArrBytes" sizeof_StgArrBytes :: Int - -foreign import ccall unsafe "offset_StgArrBytes_bytes" - offset_StgArrBytes_bytes :: Int - -foreign import ccall unsafe "offset_StgArrBytes_payload" - offset_StgArrBytes_payload :: Int - -foreign import ccall unsafe "sizeof_StgBlockingQueue" sizeof_StgBlockingQueue :: Int - -foreign import ccall unsafe "offset_StgBlockingQueue_link" offset_StgBlockingQueue_link :: Int - -foreign import ccall unsafe "offset_StgBlockingQueue_bh" offset_StgBlockingQueue_bh :: Int - -foreign import ccall unsafe "offset_StgBlockingQueue_owner" offset_StgBlockingQueue_owner :: Int - -foreign import ccall unsafe "offset_StgBlockingQueue_queue" offset_StgBlockingQueue_queue :: Int - -foreign import ccall unsafe "sizeof_StgClosure" sizeof_StgClosure :: Int - -foreign import ccall unsafe "offset_StgClosure_payload" - offset_StgClosure_payload :: Int - -foreign import ccall unsafe "sizeof_StgInd" sizeof_StgInd :: Int - -foreign import ccall unsafe "offset_StgInd_indirectee" - offset_StgInd_indirectee :: Int - -foreign import ccall unsafe "sizeof_StgIndStatic" sizeof_StgIndStatic :: Int - -foreign import ccall unsafe "offset_StgIndStatic_indirectee" - offset_StgIndStatic_indirectee :: Int - -foreign import ccall unsafe "offset_StgIndStatic_static_link" - offset_StgIndStatic_static_link :: Int - -foreign import ccall unsafe "offset_StgIndStatic_saved_info" - offset_StgIndStatic_saved_info :: Int - -foreign import ccall unsafe "offset_StgFunInfoExtraFwd_fun_type" - offset_StgFunInfoExtraFwd_fun_type :: Int - -foreign import ccall unsafe "offset_StgFunInfoExtraFwd_srt" - offset_StgFunInfoExtraFwd_srt :: Int - -foreign import ccall unsafe "offset_StgFunInfoExtraFwd_b" - offset_StgFunInfoExtraFwd_b :: Int - -foreign import ccall unsafe "offset_StgFunInfoTable_i" - offset_StgFunInfoTable_i :: Int - -foreign import ccall unsafe "offset_StgFunInfoTable_f" - offset_StgFunInfoTable_f :: Int - -foreign import ccall unsafe "sizeof_StgFunTable" sizeof_StgFunTable :: Int - -foreign import ccall unsafe "offset_StgFunTable_stgEagerBlackholeInfo" - offset_StgFunTable_stgEagerBlackholeInfo :: Int - -foreign import ccall unsafe "offset_StgFunTable_stgGCEnter1" - offset_StgFunTable_stgGCEnter1 :: Int - -foreign import ccall unsafe "offset_StgFunTable_stgGCFun" - offset_StgFunTable_stgGCFun :: Int - -foreign import ccall unsafe "offset_StgInfoTable_entry" - offset_StgInfoTable_entry :: Int - -foreign import ccall unsafe "offset_StgInfoTable_layout" - offset_StgInfoTable_layout :: Int - -foreign import ccall unsafe "offset_StgInfoTable_type" - offset_StgInfoTable_type :: Int - -foreign import ccall unsafe "offset_StgInfoTable_srt" - offset_StgInfoTable_srt :: Int - -foreign import ccall unsafe "offset_StgLargeBitmap_size" - offset_StgLargeBitmap_size :: Int - -foreign import ccall unsafe "offset_StgLargeBitmap_bitmap" - offset_StgLargeBitmap_bitmap :: Int - -foreign import ccall unsafe "sizeof_StgMutArrPtrs" sizeof_StgMutArrPtrs :: Int - -foreign import ccall unsafe "offset_StgMutArrPtrs_ptrs" - offset_StgMutArrPtrs_ptrs :: Int - -foreign import ccall unsafe "offset_StgMutArrPtrs_size" - offset_StgMutArrPtrs_size :: Int - -foreign import ccall unsafe "offset_StgMutArrPtrs_payload" - offset_StgMutArrPtrs_payload :: Int - -foreign import ccall unsafe "offset_StgMVar_head" offset_StgMVar_head :: Int - -foreign import ccall unsafe "offset_StgMVar_tail" offset_StgMVar_tail :: Int - -foreign import ccall unsafe "offset_StgMVar_value" offset_StgMVar_value :: Int - -foreign import ccall unsafe "sizeof_StgPAP" sizeof_StgPAP :: Int - -foreign import ccall unsafe "offset_StgPAP_arity" offset_StgPAP_arity :: Int - -foreign import ccall unsafe "offset_StgPAP_n_args" offset_StgPAP_n_args :: Int - -foreign import ccall unsafe "offset_StgPAP_fun" offset_StgPAP_fun :: Int - -foreign import ccall unsafe "offset_StgPAP_payload" offset_StgPAP_payload :: Int - -foreign import ccall unsafe "sizeof_StgRetFun" sizeof_StgRetFun :: Int - -foreign import ccall unsafe "offset_StgRetFun_size" offset_StgRetFun_size :: Int - -foreign import ccall unsafe "offset_StgRetFun_fun" offset_StgRetFun_fun :: Int - -foreign import ccall unsafe "offset_StgRetFun_payload" - offset_StgRetFun_payload :: Int - -foreign import ccall unsafe "offset_StgRetInfoTable_i" - offset_StgRetInfoTable_i :: Int - -foreign import ccall unsafe "offset_StgRetInfoTable_srt" - offset_StgRetInfoTable_srt :: Int - -foreign import ccall unsafe "sizeof_StgRegTable" sizeof_StgRegTable :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR1" - offset_StgRegTable_rR1 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR2" - offset_StgRegTable_rR2 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR3" - offset_StgRegTable_rR3 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR4" - offset_StgRegTable_rR4 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR5" - offset_StgRegTable_rR5 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR6" - offset_StgRegTable_rR6 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR7" - offset_StgRegTable_rR7 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR8" - offset_StgRegTable_rR8 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR9" - offset_StgRegTable_rR9 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rR10" - offset_StgRegTable_rR10 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rF1" - offset_StgRegTable_rF1 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rF2" - offset_StgRegTable_rF2 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rF3" - offset_StgRegTable_rF3 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rF4" - offset_StgRegTable_rF4 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rF5" - offset_StgRegTable_rF5 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rF6" - offset_StgRegTable_rF6 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rD1" - offset_StgRegTable_rD1 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rD2" - offset_StgRegTable_rD2 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rD3" - offset_StgRegTable_rD3 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rD4" - offset_StgRegTable_rD4 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rD5" - offset_StgRegTable_rD5 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rD6" - offset_StgRegTable_rD6 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rL1" - offset_StgRegTable_rL1 :: Int - -foreign import ccall unsafe "offset_StgRegTable_rSp" - offset_StgRegTable_rSp :: Int - -foreign import ccall unsafe "offset_StgRegTable_rSpLim" - offset_StgRegTable_rSpLim :: Int - -foreign import ccall unsafe "offset_StgRegTable_rHp" - offset_StgRegTable_rHp :: Int - -foreign import ccall unsafe "offset_StgRegTable_rHpLim" - offset_StgRegTable_rHpLim :: Int - -foreign import ccall unsafe "offset_StgRegTable_rCCCS" - offset_StgRegTable_rCCCS :: Int - -foreign import ccall unsafe "offset_StgRegTable_rNursery" - offset_StgRegTable_rNursery :: Int - -foreign import ccall unsafe "offset_StgRegTable_rCurrentTSO" - offset_StgRegTable_rCurrentTSO :: Int - -foreign import ccall unsafe "offset_StgRegTable_rCurrentNursery" - offset_StgRegTable_rCurrentNursery :: Int - -foreign import ccall unsafe "offset_StgRegTable_rCurrentAlloc" - offset_StgRegTable_rCurrentAlloc :: Int - -foreign import ccall unsafe "offset_StgRegTable_rHpAlloc" - offset_StgRegTable_rHpAlloc :: Int - -foreign import ccall unsafe "offset_StgRegTable_rRet" - offset_StgRegTable_rRet :: Int - -foreign import ccall unsafe "sizeof_StgSelector" sizeof_StgSelector :: Int - -foreign import ccall unsafe "offset_StgSelector_selectee" - offset_StgSelector_selectee :: Int - -foreign import ccall unsafe "sizeof_StgSmallMutArrPtrs" - sizeof_StgSmallMutArrPtrs :: Int - -foreign import ccall unsafe "offset_StgSmallMutArrPtrs_ptrs" - offset_StgSmallMutArrPtrs_ptrs :: Int - -foreign import ccall unsafe "offset_StgSmallMutArrPtrs_payload" - offset_StgSmallMutArrPtrs_payload :: Int - -foreign import ccall unsafe "sizeof_StgStack" sizeof_StgStack :: Int - -foreign import ccall unsafe "offset_StgStack_stack_size" - offset_StgStack_stack_size :: Int - -foreign import ccall unsafe "offset_StgStack_dirty" offset_StgStack_dirty :: Int - -foreign import ccall unsafe "offset_StgStack_sp" offset_StgStack_sp :: Int - -foreign import ccall unsafe "offset_StgStack_stack" offset_StgStack_stack :: Int - -foreign import ccall unsafe "sizeof_StgStopFrame" sizeof_StgStopFrame :: Int - -foreign import ccall unsafe "sizeof_StgThunk" sizeof_StgThunk :: Int - -foreign import ccall unsafe "offset_StgThunk_payload" - offset_StgThunk_payload :: Int - -foreign import ccall unsafe "offset_StgThunkInfoTable_i" - offset_StgThunkInfoTable_i :: Int - -foreign import ccall unsafe "offset_StgThunkInfoTable_srt" - offset_StgThunkInfoTable_srt :: Int - -foreign import ccall unsafe "sizeof_StgTSO" sizeof_StgTSO :: Int - -foreign import ccall unsafe "offset_StgTSO__link" offset_StgTSO__link :: Int - -foreign import ccall unsafe "offset_StgTSO_stackobj" - offset_StgTSO_stackobj :: Int - -foreign import ccall unsafe "offset_StgTSO_what_next" - offset_StgTSO_what_next :: Int - -foreign import ccall unsafe "offset_StgTSO_why_blocked" - offset_StgTSO_why_blocked :: Int - -foreign import ccall unsafe "offset_StgTSO_flags" offset_StgTSO_flags :: Int - -foreign import ccall unsafe "offset_StgTSO_block_info" - offset_StgTSO_block_info :: Int - -foreign import ccall unsafe "offset_StgTSO_id" offset_StgTSO_id :: Int - -foreign import ccall unsafe "offset_StgTSO_saved_errno" - offset_StgTSO_saved_errno :: Int - -foreign import ccall unsafe "offset_StgTSO_dirty" offset_StgTSO_dirty :: Int - -foreign import ccall unsafe "offset_StgTSO_bound" offset_StgTSO_bound :: Int - -foreign import ccall unsafe "offset_StgTSO_cap" offset_StgTSO_cap :: Int - -foreign import ccall unsafe "offset_StgTSO_trec" offset_StgTSO_trec :: Int - -foreign import ccall unsafe "offset_StgTSO_blocked_exceptions" - offset_StgTSO_blocked_exceptions :: Int - -foreign import ccall unsafe "offset_StgTSO_bq" offset_StgTSO_bq :: Int - -foreign import ccall unsafe "offset_StgTSO_alloc_limit" - offset_StgTSO_alloc_limit :: Int - -foreign import ccall unsafe "offset_StgTSO_tot_stack_size" - offset_StgTSO_tot_stack_size :: Int - -foreign import ccall unsafe "offset_StgUpdateFrame_updatee" - offset_StgUpdateFrame_updatee :: Int - -foreign import ccall unsafe "sizeof_StgWeak" sizeof_StgWeak :: Int - -foreign import ccall unsafe "offset_StgWeak_cfinalizers" - offset_StgWeak_cfinalizers :: Int - -foreign import ccall unsafe "offset_StgWeak_key" offset_StgWeak_key :: Int - -foreign import ccall unsafe "offset_StgWeak_value" offset_StgWeak_value :: Int - -foreign import ccall unsafe "offset_StgWeak_finalizer" - offset_StgWeak_finalizer :: Int - -foreign import ccall unsafe "offset_StgWeak_link" offset_StgWeak_link :: Int - -foreign import ccall unsafe "next_ThreadRunGHC" next_ThreadRunGHC :: Int - -foreign import ccall unsafe "next_ThreadInterpret" next_ThreadInterpret :: Int - -foreign import ccall unsafe "next_ThreadKilled" next_ThreadKilled :: Int - -foreign import ccall unsafe "next_ThreadComplete" next_ThreadComplete :: Int - -foreign import ccall unsafe "bf_EVACUATED" bf_EVACUATED :: Int - -foreign import ccall unsafe "bf_LARGE" bf_LARGE :: Int - -foreign import ccall unsafe "bf_PINNED" bf_PINNED :: Int - -foreign import ccall unsafe "bf_MARKED" bf_MARKED :: Int - -foreign import ccall unsafe "bf_EXEC" bf_EXEC :: Int - -foreign import ccall unsafe "bf_FRAGMENTED" bf_FRAGMENTED :: Int - -foreign import ccall unsafe "bf_KNOWN" bf_KNOWN :: Int - -foreign import ccall unsafe "bf_SWEPT" bf_SWEPT :: Int - -foreign import ccall unsafe "bf_COMPACT" bf_COMPACT :: Int - -foreign import ccall unsafe "blocked_NotBlocked" blocked_NotBlocked :: Int - -foreign import ccall unsafe "blocked_BlockedOnMVar" blocked_BlockedOnMVar :: Int - -foreign import ccall unsafe "blocked_BlockedOnMVarRead" - blocked_BlockedOnMVarRead :: Int - -foreign import ccall unsafe "blocked_BlockedOnBlackHole" - blocked_BlockedOnBlackHole :: Int - -foreign import ccall unsafe "blocked_BlockedOnRead" blocked_BlockedOnRead :: Int - -foreign import ccall unsafe "blocked_BlockedOnWrite" - blocked_BlockedOnWrite :: Int - -foreign import ccall unsafe "blocked_BlockedOnDelay" - blocked_BlockedOnDelay :: Int - -foreign import ccall unsafe "blocked_BlockedOnSTM" blocked_BlockedOnSTM :: Int - -foreign import ccall unsafe "blocked_BlockedOnDoProc" - blocked_BlockedOnDoProc :: Int - -foreign import ccall unsafe "blocked_BlockedOnCCall" - blocked_BlockedOnCCall :: Int - -foreign import ccall unsafe "blocked_BlockedOnCCall_Interruptible" - blocked_BlockedOnCCall_Interruptible :: Int - -foreign import ccall unsafe "blocked_BlockedOnMsgThrowTo" - blocked_BlockedOnMsgThrowTo :: Int - -foreign import ccall unsafe "blocked_ThreadMigrating" - blocked_ThreadMigrating :: Int - -foreign import ccall unsafe "ret_HeapOverflow" ret_HeapOverflow :: Int - -foreign import ccall unsafe "ret_StackOverflow" ret_StackOverflow :: Int - -foreign import ccall unsafe "ret_ThreadYielding" ret_ThreadYielding :: Int - -foreign import ccall unsafe "ret_ThreadBlocked" ret_ThreadBlocked :: Int - -foreign import ccall unsafe "ret_ThreadFinished" ret_ThreadFinished :: Int - -foreign import ccall unsafe "sched_SCHED_RUNNING" sched_SCHED_RUNNING :: Int - -foreign import ccall unsafe "sched_SCHED_INTERRUPTING" - sched_SCHED_INTERRUPTING :: Int - -foreign import ccall unsafe "sched_SCHED_SHUTTING_DOWN" - sched_SCHED_SHUTTING_DOWN :: Int - -foreign import ccall unsafe "scheduler_NoStatus" scheduler_NoStatus :: Int - -foreign import ccall unsafe "scheduler_Success" scheduler_Success :: Int - -foreign import ccall unsafe "scheduler_Killed" scheduler_Killed :: Int - -foreign import ccall unsafe "scheduler_Interrupted" scheduler_Interrupted :: Int - -foreign import ccall unsafe "scheduler_HeapExhausted" - scheduler_HeapExhausted :: Int - -foreign import ccall unsafe "sizeof_bool" sizeof_bool :: Int - -foreign import ccall unsafe "sizeof_int" sizeof_int :: Int - -foreign import ccall unsafe "sizeof_SchedulerStatus" - sizeof_SchedulerStatus :: Int - -foreign import ccall unsafe "tso_LOCKED" tso_LOCKED :: Int - -foreign import ccall unsafe "tso_BLOCKEX" tso_BLOCKEX :: Int - -foreign import ccall unsafe "tso_INTERRUPTIBLE" tso_INTERRUPTIBLE :: Int - -foreign import ccall unsafe "tso_STOPPED_ON_BREAKPOINT" - tso_STOPPED_ON_BREAKPOINT :: Int - -foreign import ccall unsafe "tso_MARKED" tso_MARKED :: Int - -foreign import ccall unsafe "tso_SQUEEZED" tso_SQUEEZED :: Int - -foreign import ccall unsafe "tso_ALLOC_LIMIT" tso_ALLOC_LIMIT :: Int - -foreign import ccall unsafe "sizeof_StgStableName" sizeof_StgStableName :: Int - -foreign import ccall unsafe "offset_StgStableName_header" - offset_StgStableName_header :: Int - -foreign import ccall unsafe "offset_StgStableName_sn" - offset_StgStableName_sn :: Int - -foreign import ccall unsafe "clock_monotonic" clock_monotonic :: Int - -foreign import ccall unsafe "clock_realtime" clock_realtime :: Int +import Control.Monad +import System.Environment.Blank +import System.Exit +import System.IO.Unsafe +import System.Process + +wasmtimeInvoke :: String -> [Int] -> IO Int +wasmtimeInvoke _func _args = do + Just _wasm <- getEnv "AHC_CONSTANTS" + (_exit_code, _stdout, _stderr) <- + readProcessWithExitCode + "wasmtime" + ([_wasm, "--invoke", _func] <> map show _args) + "" + when (_exit_code /= ExitSuccess) $ fail $ "wasmtime failed with " <> _stderr + pure $ read _stdout + +{-# NOINLINE offset_timespec_tv_sec #-} +offset_timespec_tv_sec :: Int +offset_timespec_tv_sec = + unsafePerformIO $ wasmtimeInvoke "offset_timespec_tv_sec" [] + +{-# NOINLINE offset_timespec_tv_nsec #-} +offset_timespec_tv_nsec :: Int +offset_timespec_tv_nsec = + unsafePerformIO $ wasmtimeInvoke "offset_timespec_tv_nsec" [] + +{-# NOINLINE roundup #-} +roundup :: Int -> Int -> Int +roundup x n = unsafePerformIO $ wasmtimeInvoke "roundup" [x, n] + +{-# NOINLINE roundup_bytes_to_words #-} +roundup_bytes_to_words :: Int -> Int +roundup_bytes_to_words n = + unsafePerformIO $ wasmtimeInvoke "roundup_bytes_to_words" [n] + +{-# NOINLINE block_size #-} +block_size :: Int +block_size = unsafePerformIO $ wasmtimeInvoke "block_size" [] + +{-# NOINLINE mblock_size #-} +mblock_size :: Int +mblock_size = unsafePerformIO $ wasmtimeInvoke "mblock_size" [] + +{-# NOINLINE blocks_per_mblock #-} +blocks_per_mblock :: Int +blocks_per_mblock = unsafePerformIO $ wasmtimeInvoke "blocks_per_mblock" [] + +{-# NOINLINE offset_first_bdescr #-} +offset_first_bdescr :: Int +offset_first_bdescr = unsafePerformIO $ wasmtimeInvoke "offset_first_bdescr" [] + +{-# NOINLINE offset_last_bdescr #-} +offset_last_bdescr :: Int +offset_last_bdescr = unsafePerformIO $ wasmtimeInvoke "offset_last_bdescr" [] + +{-# NOINLINE offset_first_block #-} +offset_first_block :: Int +offset_first_block = unsafePerformIO $ wasmtimeInvoke "offset_first_block" [] + +{-# NOINLINE offset_last_block #-} +offset_last_block :: Int +offset_last_block = unsafePerformIO $ wasmtimeInvoke "offset_last_block" [] + +{-# NOINLINE sizeof_bdescr #-} +sizeof_bdescr :: Int +sizeof_bdescr = unsafePerformIO $ wasmtimeInvoke "sizeof_bdescr" [] + +{-# NOINLINE offset_bdescr_start #-} +offset_bdescr_start :: Int +offset_bdescr_start = unsafePerformIO $ wasmtimeInvoke "offset_bdescr_start" [] + +{-# NOINLINE offset_bdescr_free #-} +offset_bdescr_free :: Int +offset_bdescr_free = unsafePerformIO $ wasmtimeInvoke "offset_bdescr_free" [] + +{-# NOINLINE offset_bdescr_link #-} +offset_bdescr_link :: Int +offset_bdescr_link = unsafePerformIO $ wasmtimeInvoke "offset_bdescr_link" [] + +{-# NOINLINE offset_bdescr_gen_no #-} +offset_bdescr_gen_no :: Int +offset_bdescr_gen_no = + unsafePerformIO $ wasmtimeInvoke "offset_bdescr_gen_no" [] + +{-# NOINLINE offset_bdescr_node #-} +offset_bdescr_node :: Int +offset_bdescr_node = unsafePerformIO $ wasmtimeInvoke "offset_bdescr_node" [] + +{-# NOINLINE offset_bdescr_flags #-} +offset_bdescr_flags :: Int +offset_bdescr_flags = unsafePerformIO $ wasmtimeInvoke "offset_bdescr_flags" [] + +{-# NOINLINE offset_bdescr_blocks #-} +offset_bdescr_blocks :: Int +offset_bdescr_blocks = + unsafePerformIO $ wasmtimeInvoke "offset_bdescr_blocks" [] + +{-# NOINLINE sizeof_Capability #-} +sizeof_Capability :: Int +sizeof_Capability = unsafePerformIO $ wasmtimeInvoke "sizeof_Capability" [] + +{-# NOINLINE offset_Capability_f #-} +offset_Capability_f :: Int +offset_Capability_f = unsafePerformIO $ wasmtimeInvoke "offset_Capability_f" [] + +{-# NOINLINE offset_Capability_r #-} +offset_Capability_r :: Int +offset_Capability_r = unsafePerformIO $ wasmtimeInvoke "offset_Capability_r" [] + +{-# NOINLINE offset_Capability_no #-} +offset_Capability_no :: Int +offset_Capability_no = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_no" [] + +{-# NOINLINE offset_Capability_node #-} +offset_Capability_node :: Int +offset_Capability_node = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_node" [] + +{-# NOINLINE offset_Capability_running_task #-} +offset_Capability_running_task :: Int +offset_Capability_running_task = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_running_task" [] + +{-# NOINLINE offset_Capability_in_haskell #-} +offset_Capability_in_haskell :: Int +offset_Capability_in_haskell = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_in_haskell" [] + +{-# NOINLINE offset_Capability_idle #-} +offset_Capability_idle :: Int +offset_Capability_idle = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_idle" [] + +{-# NOINLINE offset_Capability_disabled #-} +offset_Capability_disabled :: Int +offset_Capability_disabled = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_disabled" [] + +{-# NOINLINE offset_Capability_run_queue_hd #-} +offset_Capability_run_queue_hd :: Int +offset_Capability_run_queue_hd = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_run_queue_hd" [] + +{-# NOINLINE offset_Capability_run_queue_tl #-} +offset_Capability_run_queue_tl :: Int +offset_Capability_run_queue_tl = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_run_queue_tl" [] + +{-# NOINLINE offset_Capability_n_run_queue #-} +offset_Capability_n_run_queue :: Int +offset_Capability_n_run_queue = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_n_run_queue" [] + +{-# NOINLINE offset_Capability_suspended_ccalls #-} +offset_Capability_suspended_ccalls :: Int +offset_Capability_suspended_ccalls = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_suspended_ccalls" [] + +{-# NOINLINE offset_Capability_n_suspended_ccalls #-} +offset_Capability_n_suspended_ccalls :: Int +offset_Capability_n_suspended_ccalls = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_n_suspended_ccalls" [] + +{-# NOINLINE offset_Capability_mut_lists #-} +offset_Capability_mut_lists :: Int +offset_Capability_mut_lists = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_mut_lists" [] + +{-# NOINLINE offset_Capability_saved_mut_lists #-} +offset_Capability_saved_mut_lists :: Int +offset_Capability_saved_mut_lists = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_saved_mut_lists" [] + +{-# NOINLINE offset_Capability_pinned_object_block #-} +offset_Capability_pinned_object_block :: Int +offset_Capability_pinned_object_block = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_pinned_object_block" [] + +{-# NOINLINE offset_Capability_pinned_object_blocks #-} +offset_Capability_pinned_object_blocks :: Int +offset_Capability_pinned_object_blocks = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_pinned_object_blocks" [] + +{-# NOINLINE offset_Capability_weak_ptr_list_hd #-} +offset_Capability_weak_ptr_list_hd :: Int +offset_Capability_weak_ptr_list_hd = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_weak_ptr_list_hd" [] + +{-# NOINLINE offset_Capability_weak_ptr_list_tl #-} +offset_Capability_weak_ptr_list_tl :: Int +offset_Capability_weak_ptr_list_tl = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_weak_ptr_list_tl" [] + +{-# NOINLINE offset_Capability_context_switch #-} +offset_Capability_context_switch :: Int +offset_Capability_context_switch = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_context_switch" [] + +{-# NOINLINE offset_Capability_interrupt #-} +offset_Capability_interrupt :: Int +offset_Capability_interrupt = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_interrupt" [] + +{-# NOINLINE offset_Capability_total_allocated #-} +offset_Capability_total_allocated :: Int +offset_Capability_total_allocated = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_total_allocated" [] + +{-# NOINLINE offset_Capability_free_tvar_watch_queues #-} +offset_Capability_free_tvar_watch_queues :: Int +offset_Capability_free_tvar_watch_queues = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_free_tvar_watch_queues" [] + +{-# NOINLINE offset_Capability_free_trec_chunks #-} +offset_Capability_free_trec_chunks :: Int +offset_Capability_free_trec_chunks = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_free_trec_chunks" [] + +{-# NOINLINE offset_Capability_free_trec_headers #-} +offset_Capability_free_trec_headers :: Int +offset_Capability_free_trec_headers = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_free_trec_headers" [] + +{-# NOINLINE offset_Capability_transaction_tokens #-} +offset_Capability_transaction_tokens :: Int +offset_Capability_transaction_tokens = + unsafePerformIO $ wasmtimeInvoke "offset_Capability_transaction_tokens" [] + +{-# NOINLINE sizeof_MessageBlackHole #-} +sizeof_MessageBlackHole :: Int +sizeof_MessageBlackHole = + unsafePerformIO $ wasmtimeInvoke "sizeof_MessageBlackHole" [] + +{-# NOINLINE offset_MessageBlackHole_link #-} +offset_MessageBlackHole_link :: Int +offset_MessageBlackHole_link = + unsafePerformIO $ wasmtimeInvoke "offset_MessageBlackHole_link" [] + +{-# NOINLINE offset_MessageBlackHole_tso #-} +offset_MessageBlackHole_tso :: Int +offset_MessageBlackHole_tso = + unsafePerformIO $ wasmtimeInvoke "offset_MessageBlackHole_tso" [] + +{-# NOINLINE offset_MessageBlackHole_bh #-} +offset_MessageBlackHole_bh :: Int +offset_MessageBlackHole_bh = + unsafePerformIO $ wasmtimeInvoke "offset_MessageBlackHole_bh" [] + +{-# NOINLINE sizeof_StgAP #-} +sizeof_StgAP :: Int +sizeof_StgAP = unsafePerformIO $ wasmtimeInvoke "sizeof_StgAP" [] + +{-# NOINLINE offset_StgAP_arity #-} +offset_StgAP_arity :: Int +offset_StgAP_arity = unsafePerformIO $ wasmtimeInvoke "offset_StgAP_arity" [] + +{-# NOINLINE offset_StgAP_n_args #-} +offset_StgAP_n_args :: Int +offset_StgAP_n_args = unsafePerformIO $ wasmtimeInvoke "offset_StgAP_n_args" [] + +{-# NOINLINE offset_StgAP_fun #-} +offset_StgAP_fun :: Int +offset_StgAP_fun = unsafePerformIO $ wasmtimeInvoke "offset_StgAP_fun" [] + +{-# NOINLINE offset_StgAP_payload #-} +offset_StgAP_payload :: Int +offset_StgAP_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgAP_payload" [] + +{-# NOINLINE sizeof_StgAP_STACK #-} +sizeof_StgAP_STACK :: Int +sizeof_StgAP_STACK = unsafePerformIO $ wasmtimeInvoke "sizeof_StgAP_STACK" [] + +{-# NOINLINE offset_StgAP_STACK_size #-} +offset_StgAP_STACK_size :: Int +offset_StgAP_STACK_size = + unsafePerformIO $ wasmtimeInvoke "offset_StgAP_STACK_size" [] + +{-# NOINLINE offset_StgAP_STACK_fun #-} +offset_StgAP_STACK_fun :: Int +offset_StgAP_STACK_fun = + unsafePerformIO $ wasmtimeInvoke "offset_StgAP_STACK_fun" [] + +{-# NOINLINE offset_StgAP_STACK_payload #-} +offset_StgAP_STACK_payload :: Int +offset_StgAP_STACK_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgAP_STACK_payload" [] + +{-# NOINLINE sizeof_StgArrBytes #-} +sizeof_StgArrBytes :: Int +sizeof_StgArrBytes = unsafePerformIO $ wasmtimeInvoke "sizeof_StgArrBytes" [] + +{-# NOINLINE offset_StgArrBytes_bytes #-} +offset_StgArrBytes_bytes :: Int +offset_StgArrBytes_bytes = + unsafePerformIO $ wasmtimeInvoke "offset_StgArrBytes_bytes" [] + +{-# NOINLINE offset_StgArrBytes_payload #-} +offset_StgArrBytes_payload :: Int +offset_StgArrBytes_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgArrBytes_payload" [] + +{-# NOINLINE sizeof_StgBlockingQueue #-} +sizeof_StgBlockingQueue :: Int +sizeof_StgBlockingQueue = + unsafePerformIO $ wasmtimeInvoke "sizeof_StgBlockingQueue" [] + +{-# NOINLINE offset_StgBlockingQueue_link #-} +offset_StgBlockingQueue_link :: Int +offset_StgBlockingQueue_link = + unsafePerformIO $ wasmtimeInvoke "offset_StgBlockingQueue_link" [] + +{-# NOINLINE offset_StgBlockingQueue_bh #-} +offset_StgBlockingQueue_bh :: Int +offset_StgBlockingQueue_bh = + unsafePerformIO $ wasmtimeInvoke "offset_StgBlockingQueue_bh" [] + +{-# NOINLINE offset_StgBlockingQueue_owner #-} +offset_StgBlockingQueue_owner :: Int +offset_StgBlockingQueue_owner = + unsafePerformIO $ wasmtimeInvoke "offset_StgBlockingQueue_owner" [] + +{-# NOINLINE offset_StgBlockingQueue_queue #-} +offset_StgBlockingQueue_queue :: Int +offset_StgBlockingQueue_queue = + unsafePerformIO $ wasmtimeInvoke "offset_StgBlockingQueue_queue" [] + +{-# NOINLINE sizeof_StgClosure #-} +sizeof_StgClosure :: Int +sizeof_StgClosure = unsafePerformIO $ wasmtimeInvoke "sizeof_StgClosure" [] + +{-# NOINLINE offset_StgClosure_payload #-} +offset_StgClosure_payload :: Int +offset_StgClosure_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgClosure_payload" [] + +{-# NOINLINE sizeof_StgInd #-} +sizeof_StgInd :: Int +sizeof_StgInd = unsafePerformIO $ wasmtimeInvoke "sizeof_StgInd" [] + +{-# NOINLINE offset_StgInd_indirectee #-} +offset_StgInd_indirectee :: Int +offset_StgInd_indirectee = + unsafePerformIO $ wasmtimeInvoke "offset_StgInd_indirectee" [] + +{-# NOINLINE sizeof_StgIndStatic #-} +sizeof_StgIndStatic :: Int +sizeof_StgIndStatic = unsafePerformIO $ wasmtimeInvoke "sizeof_StgIndStatic" [] + +{-# NOINLINE offset_StgIndStatic_indirectee #-} +offset_StgIndStatic_indirectee :: Int +offset_StgIndStatic_indirectee = + unsafePerformIO $ wasmtimeInvoke "offset_StgIndStatic_indirectee" [] + +{-# NOINLINE offset_StgIndStatic_static_link #-} +offset_StgIndStatic_static_link :: Int +offset_StgIndStatic_static_link = + unsafePerformIO $ wasmtimeInvoke "offset_StgIndStatic_static_link" [] + +{-# NOINLINE offset_StgIndStatic_saved_info #-} +offset_StgIndStatic_saved_info :: Int +offset_StgIndStatic_saved_info = + unsafePerformIO $ wasmtimeInvoke "offset_StgIndStatic_saved_info" [] + +{-# NOINLINE offset_StgFunInfoExtraFwd_fun_type #-} +offset_StgFunInfoExtraFwd_fun_type :: Int +offset_StgFunInfoExtraFwd_fun_type = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunInfoExtraFwd_fun_type" [] + +{-# NOINLINE offset_StgFunInfoExtraFwd_srt #-} +offset_StgFunInfoExtraFwd_srt :: Int +offset_StgFunInfoExtraFwd_srt = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunInfoExtraFwd_srt" [] + +{-# NOINLINE offset_StgFunInfoExtraFwd_b #-} +offset_StgFunInfoExtraFwd_b :: Int +offset_StgFunInfoExtraFwd_b = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunInfoExtraFwd_b" [] + +{-# NOINLINE offset_StgFunInfoTable_i #-} +offset_StgFunInfoTable_i :: Int +offset_StgFunInfoTable_i = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunInfoTable_i" [] + +{-# NOINLINE offset_StgFunInfoTable_f #-} +offset_StgFunInfoTable_f :: Int +offset_StgFunInfoTable_f = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunInfoTable_f" [] + +{-# NOINLINE sizeof_StgFunTable #-} +sizeof_StgFunTable :: Int +sizeof_StgFunTable = unsafePerformIO $ wasmtimeInvoke "sizeof_StgFunTable" [] + +{-# NOINLINE offset_StgFunTable_stgEagerBlackholeInfo #-} +offset_StgFunTable_stgEagerBlackholeInfo :: Int +offset_StgFunTable_stgEagerBlackholeInfo = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunTable_stgEagerBlackholeInfo" [] + +{-# NOINLINE offset_StgFunTable_stgGCEnter1 #-} +offset_StgFunTable_stgGCEnter1 :: Int +offset_StgFunTable_stgGCEnter1 = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunTable_stgGCEnter1" [] + +{-# NOINLINE offset_StgFunTable_stgGCFun #-} +offset_StgFunTable_stgGCFun :: Int +offset_StgFunTable_stgGCFun = + unsafePerformIO $ wasmtimeInvoke "offset_StgFunTable_stgGCFun" [] + +{-# NOINLINE offset_StgInfoTable_entry #-} +offset_StgInfoTable_entry :: Int +offset_StgInfoTable_entry = + unsafePerformIO $ wasmtimeInvoke "offset_StgInfoTable_entry" [] + +{-# NOINLINE offset_StgInfoTable_layout #-} +offset_StgInfoTable_layout :: Int +offset_StgInfoTable_layout = + unsafePerformIO $ wasmtimeInvoke "offset_StgInfoTable_layout" [] + +{-# NOINLINE offset_StgInfoTable_type #-} +offset_StgInfoTable_type :: Int +offset_StgInfoTable_type = + unsafePerformIO $ wasmtimeInvoke "offset_StgInfoTable_type" [] + +{-# NOINLINE offset_StgInfoTable_srt #-} +offset_StgInfoTable_srt :: Int +offset_StgInfoTable_srt = + unsafePerformIO $ wasmtimeInvoke "offset_StgInfoTable_srt" [] + +{-# NOINLINE offset_StgLargeBitmap_size #-} +offset_StgLargeBitmap_size :: Int +offset_StgLargeBitmap_size = + unsafePerformIO $ wasmtimeInvoke "offset_StgLargeBitmap_size" [] + +{-# NOINLINE offset_StgLargeBitmap_bitmap #-} +offset_StgLargeBitmap_bitmap :: Int +offset_StgLargeBitmap_bitmap = + unsafePerformIO $ wasmtimeInvoke "offset_StgLargeBitmap_bitmap" [] + +{-# NOINLINE sizeof_StgMutArrPtrs #-} +sizeof_StgMutArrPtrs :: Int +sizeof_StgMutArrPtrs = + unsafePerformIO $ wasmtimeInvoke "sizeof_StgMutArrPtrs" [] + +{-# NOINLINE offset_StgMutArrPtrs_ptrs #-} +offset_StgMutArrPtrs_ptrs :: Int +offset_StgMutArrPtrs_ptrs = + unsafePerformIO $ wasmtimeInvoke "offset_StgMutArrPtrs_ptrs" [] + +{-# NOINLINE offset_StgMutArrPtrs_size #-} +offset_StgMutArrPtrs_size :: Int +offset_StgMutArrPtrs_size = + unsafePerformIO $ wasmtimeInvoke "offset_StgMutArrPtrs_size" [] + +{-# NOINLINE offset_StgMutArrPtrs_payload #-} +offset_StgMutArrPtrs_payload :: Int +offset_StgMutArrPtrs_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgMutArrPtrs_payload" [] + +{-# NOINLINE offset_StgMVar_head #-} +offset_StgMVar_head :: Int +offset_StgMVar_head = unsafePerformIO $ wasmtimeInvoke "offset_StgMVar_head" [] + +{-# NOINLINE offset_StgMVar_tail #-} +offset_StgMVar_tail :: Int +offset_StgMVar_tail = unsafePerformIO $ wasmtimeInvoke "offset_StgMVar_tail" [] + +{-# NOINLINE offset_StgMVar_value #-} +offset_StgMVar_value :: Int +offset_StgMVar_value = + unsafePerformIO $ wasmtimeInvoke "offset_StgMVar_value" [] + +{-# NOINLINE sizeof_StgPAP #-} +sizeof_StgPAP :: Int +sizeof_StgPAP = unsafePerformIO $ wasmtimeInvoke "sizeof_StgPAP" [] + +{-# NOINLINE offset_StgPAP_arity #-} +offset_StgPAP_arity :: Int +offset_StgPAP_arity = unsafePerformIO $ wasmtimeInvoke "offset_StgPAP_arity" [] + +{-# NOINLINE offset_StgPAP_n_args #-} +offset_StgPAP_n_args :: Int +offset_StgPAP_n_args = + unsafePerformIO $ wasmtimeInvoke "offset_StgPAP_n_args" [] + +{-# NOINLINE offset_StgPAP_fun #-} +offset_StgPAP_fun :: Int +offset_StgPAP_fun = unsafePerformIO $ wasmtimeInvoke "offset_StgPAP_fun" [] + +{-# NOINLINE offset_StgPAP_payload #-} +offset_StgPAP_payload :: Int +offset_StgPAP_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgPAP_payload" [] + +{-# NOINLINE sizeof_StgRetFun #-} +sizeof_StgRetFun :: Int +sizeof_StgRetFun = unsafePerformIO $ wasmtimeInvoke "sizeof_StgRetFun" [] + +{-# NOINLINE offset_StgRetFun_size #-} +offset_StgRetFun_size :: Int +offset_StgRetFun_size = + unsafePerformIO $ wasmtimeInvoke "offset_StgRetFun_size" [] + +{-# NOINLINE offset_StgRetFun_fun #-} +offset_StgRetFun_fun :: Int +offset_StgRetFun_fun = + unsafePerformIO $ wasmtimeInvoke "offset_StgRetFun_fun" [] + +{-# NOINLINE offset_StgRetFun_payload #-} +offset_StgRetFun_payload :: Int +offset_StgRetFun_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgRetFun_payload" [] + +{-# NOINLINE offset_StgRetInfoTable_i #-} +offset_StgRetInfoTable_i :: Int +offset_StgRetInfoTable_i = + unsafePerformIO $ wasmtimeInvoke "offset_StgRetInfoTable_i" [] + +{-# NOINLINE offset_StgRetInfoTable_srt #-} +offset_StgRetInfoTable_srt :: Int +offset_StgRetInfoTable_srt = + unsafePerformIO $ wasmtimeInvoke "offset_StgRetInfoTable_srt" [] + +{-# NOINLINE sizeof_StgRegTable #-} +sizeof_StgRegTable :: Int +sizeof_StgRegTable = unsafePerformIO $ wasmtimeInvoke "sizeof_StgRegTable" [] + +{-# NOINLINE offset_StgRegTable_rR1 #-} +offset_StgRegTable_rR1 :: Int +offset_StgRegTable_rR1 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR1" [] + +{-# NOINLINE offset_StgRegTable_rR2 #-} +offset_StgRegTable_rR2 :: Int +offset_StgRegTable_rR2 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR2" [] + +{-# NOINLINE offset_StgRegTable_rR3 #-} +offset_StgRegTable_rR3 :: Int +offset_StgRegTable_rR3 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR3" [] + +{-# NOINLINE offset_StgRegTable_rR4 #-} +offset_StgRegTable_rR4 :: Int +offset_StgRegTable_rR4 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR4" [] + +{-# NOINLINE offset_StgRegTable_rR5 #-} +offset_StgRegTable_rR5 :: Int +offset_StgRegTable_rR5 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR5" [] + +{-# NOINLINE offset_StgRegTable_rR6 #-} +offset_StgRegTable_rR6 :: Int +offset_StgRegTable_rR6 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR6" [] + +{-# NOINLINE offset_StgRegTable_rR7 #-} +offset_StgRegTable_rR7 :: Int +offset_StgRegTable_rR7 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR7" [] + +{-# NOINLINE offset_StgRegTable_rR8 #-} +offset_StgRegTable_rR8 :: Int +offset_StgRegTable_rR8 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR8" [] + +{-# NOINLINE offset_StgRegTable_rR9 #-} +offset_StgRegTable_rR9 :: Int +offset_StgRegTable_rR9 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR9" [] + +{-# NOINLINE offset_StgRegTable_rR10 #-} +offset_StgRegTable_rR10 :: Int +offset_StgRegTable_rR10 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rR10" [] + +{-# NOINLINE offset_StgRegTable_rF1 #-} +offset_StgRegTable_rF1 :: Int +offset_StgRegTable_rF1 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rF1" [] + +{-# NOINLINE offset_StgRegTable_rF2 #-} +offset_StgRegTable_rF2 :: Int +offset_StgRegTable_rF2 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rF2" [] + +{-# NOINLINE offset_StgRegTable_rF3 #-} +offset_StgRegTable_rF3 :: Int +offset_StgRegTable_rF3 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rF3" [] + +{-# NOINLINE offset_StgRegTable_rF4 #-} +offset_StgRegTable_rF4 :: Int +offset_StgRegTable_rF4 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rF4" [] + +{-# NOINLINE offset_StgRegTable_rF5 #-} +offset_StgRegTable_rF5 :: Int +offset_StgRegTable_rF5 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rF5" [] + +{-# NOINLINE offset_StgRegTable_rF6 #-} +offset_StgRegTable_rF6 :: Int +offset_StgRegTable_rF6 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rF6" [] + +{-# NOINLINE offset_StgRegTable_rD1 #-} +offset_StgRegTable_rD1 :: Int +offset_StgRegTable_rD1 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rD1" [] + +{-# NOINLINE offset_StgRegTable_rD2 #-} +offset_StgRegTable_rD2 :: Int +offset_StgRegTable_rD2 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rD2" [] + +{-# NOINLINE offset_StgRegTable_rD3 #-} +offset_StgRegTable_rD3 :: Int +offset_StgRegTable_rD3 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rD3" [] + +{-# NOINLINE offset_StgRegTable_rD4 #-} +offset_StgRegTable_rD4 :: Int +offset_StgRegTable_rD4 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rD4" [] + +{-# NOINLINE offset_StgRegTable_rD5 #-} +offset_StgRegTable_rD5 :: Int +offset_StgRegTable_rD5 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rD5" [] + +{-# NOINLINE offset_StgRegTable_rD6 #-} +offset_StgRegTable_rD6 :: Int +offset_StgRegTable_rD6 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rD6" [] + +{-# NOINLINE offset_StgRegTable_rL1 #-} +offset_StgRegTable_rL1 :: Int +offset_StgRegTable_rL1 = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rL1" [] + +{-# NOINLINE offset_StgRegTable_rSp #-} +offset_StgRegTable_rSp :: Int +offset_StgRegTable_rSp = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rSp" [] + +{-# NOINLINE offset_StgRegTable_rSpLim #-} +offset_StgRegTable_rSpLim :: Int +offset_StgRegTable_rSpLim = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rSpLim" [] + +{-# NOINLINE offset_StgRegTable_rHp #-} +offset_StgRegTable_rHp :: Int +offset_StgRegTable_rHp = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rHp" [] + +{-# NOINLINE offset_StgRegTable_rHpLim #-} +offset_StgRegTable_rHpLim :: Int +offset_StgRegTable_rHpLim = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rHpLim" [] + +{-# NOINLINE offset_StgRegTable_rCCCS #-} +offset_StgRegTable_rCCCS :: Int +offset_StgRegTable_rCCCS = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rCCCS" [] + +{-# NOINLINE offset_StgRegTable_rNursery #-} +offset_StgRegTable_rNursery :: Int +offset_StgRegTable_rNursery = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rNursery" [] + +{-# NOINLINE offset_StgRegTable_rCurrentTSO #-} +offset_StgRegTable_rCurrentTSO :: Int +offset_StgRegTable_rCurrentTSO = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rCurrentTSO" [] + +{-# NOINLINE offset_StgRegTable_rCurrentNursery #-} +offset_StgRegTable_rCurrentNursery :: Int +offset_StgRegTable_rCurrentNursery = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rCurrentNursery" [] + +{-# NOINLINE offset_StgRegTable_rCurrentAlloc #-} +offset_StgRegTable_rCurrentAlloc :: Int +offset_StgRegTable_rCurrentAlloc = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rCurrentAlloc" [] + +{-# NOINLINE offset_StgRegTable_rHpAlloc #-} +offset_StgRegTable_rHpAlloc :: Int +offset_StgRegTable_rHpAlloc = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rHpAlloc" [] + +{-# NOINLINE offset_StgRegTable_rRet #-} +offset_StgRegTable_rRet :: Int +offset_StgRegTable_rRet = + unsafePerformIO $ wasmtimeInvoke "offset_StgRegTable_rRet" [] + +{-# NOINLINE sizeof_StgSelector #-} +sizeof_StgSelector :: Int +sizeof_StgSelector = unsafePerformIO $ wasmtimeInvoke "sizeof_StgSelector" [] + +{-# NOINLINE offset_StgSelector_selectee #-} +offset_StgSelector_selectee :: Int +offset_StgSelector_selectee = + unsafePerformIO $ wasmtimeInvoke "offset_StgSelector_selectee" [] + +{-# NOINLINE sizeof_StgSmallMutArrPtrs #-} +sizeof_StgSmallMutArrPtrs :: Int +sizeof_StgSmallMutArrPtrs = + unsafePerformIO $ wasmtimeInvoke "sizeof_StgSmallMutArrPtrs" [] + +{-# NOINLINE offset_StgSmallMutArrPtrs_ptrs #-} +offset_StgSmallMutArrPtrs_ptrs :: Int +offset_StgSmallMutArrPtrs_ptrs = + unsafePerformIO $ wasmtimeInvoke "offset_StgSmallMutArrPtrs_ptrs" [] + +{-# NOINLINE offset_StgSmallMutArrPtrs_payload #-} +offset_StgSmallMutArrPtrs_payload :: Int +offset_StgSmallMutArrPtrs_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgSmallMutArrPtrs_payload" [] + +{-# NOINLINE sizeof_StgStack #-} +sizeof_StgStack :: Int +sizeof_StgStack = unsafePerformIO $ wasmtimeInvoke "sizeof_StgStack" [] + +{-# NOINLINE offset_StgStack_stack_size #-} +offset_StgStack_stack_size :: Int +offset_StgStack_stack_size = + unsafePerformIO $ wasmtimeInvoke "offset_StgStack_stack_size" [] + +{-# NOINLINE offset_StgStack_dirty #-} +offset_StgStack_dirty :: Int +offset_StgStack_dirty = + unsafePerformIO $ wasmtimeInvoke "offset_StgStack_dirty" [] + +{-# NOINLINE offset_StgStack_sp #-} +offset_StgStack_sp :: Int +offset_StgStack_sp = unsafePerformIO $ wasmtimeInvoke "offset_StgStack_sp" [] + +{-# NOINLINE offset_StgStack_stack #-} +offset_StgStack_stack :: Int +offset_StgStack_stack = + unsafePerformIO $ wasmtimeInvoke "offset_StgStack_stack" [] + +{-# NOINLINE sizeof_StgStopFrame #-} +sizeof_StgStopFrame :: Int +sizeof_StgStopFrame = unsafePerformIO $ wasmtimeInvoke "sizeof_StgStopFrame" [] + +{-# NOINLINE sizeof_StgThunk #-} +sizeof_StgThunk :: Int +sizeof_StgThunk = unsafePerformIO $ wasmtimeInvoke "sizeof_StgThunk" [] + +{-# NOINLINE offset_StgThunk_payload #-} +offset_StgThunk_payload :: Int +offset_StgThunk_payload = + unsafePerformIO $ wasmtimeInvoke "offset_StgThunk_payload" [] + +{-# NOINLINE offset_StgThunkInfoTable_i #-} +offset_StgThunkInfoTable_i :: Int +offset_StgThunkInfoTable_i = + unsafePerformIO $ wasmtimeInvoke "offset_StgThunkInfoTable_i" [] + +{-# NOINLINE offset_StgThunkInfoTable_srt #-} +offset_StgThunkInfoTable_srt :: Int +offset_StgThunkInfoTable_srt = + unsafePerformIO $ wasmtimeInvoke "offset_StgThunkInfoTable_srt" [] + +{-# NOINLINE sizeof_StgTSO #-} +sizeof_StgTSO :: Int +sizeof_StgTSO = unsafePerformIO $ wasmtimeInvoke "sizeof_StgTSO" [] + +{-# NOINLINE offset_StgTSO__link #-} +offset_StgTSO__link :: Int +offset_StgTSO__link = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO__link" [] + +{-# NOINLINE offset_StgTSO_stackobj #-} +offset_StgTSO_stackobj :: Int +offset_StgTSO_stackobj = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_stackobj" [] + +{-# NOINLINE offset_StgTSO_what_next #-} +offset_StgTSO_what_next :: Int +offset_StgTSO_what_next = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_what_next" [] + +{-# NOINLINE offset_StgTSO_why_blocked #-} +offset_StgTSO_why_blocked :: Int +offset_StgTSO_why_blocked = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_why_blocked" [] + +{-# NOINLINE offset_StgTSO_flags #-} +offset_StgTSO_flags :: Int +offset_StgTSO_flags = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_flags" [] + +{-# NOINLINE offset_StgTSO_block_info #-} +offset_StgTSO_block_info :: Int +offset_StgTSO_block_info = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_block_info" [] + +{-# NOINLINE offset_StgTSO_id #-} +offset_StgTSO_id :: Int +offset_StgTSO_id = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_id" [] + +{-# NOINLINE offset_StgTSO_saved_errno #-} +offset_StgTSO_saved_errno :: Int +offset_StgTSO_saved_errno = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_saved_errno" [] + +{-# NOINLINE offset_StgTSO_dirty #-} +offset_StgTSO_dirty :: Int +offset_StgTSO_dirty = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_dirty" [] + +{-# NOINLINE offset_StgTSO_bound #-} +offset_StgTSO_bound :: Int +offset_StgTSO_bound = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_bound" [] + +{-# NOINLINE offset_StgTSO_cap #-} +offset_StgTSO_cap :: Int +offset_StgTSO_cap = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_cap" [] + +{-# NOINLINE offset_StgTSO_trec #-} +offset_StgTSO_trec :: Int +offset_StgTSO_trec = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_trec" [] + +{-# NOINLINE offset_StgTSO_blocked_exceptions #-} +offset_StgTSO_blocked_exceptions :: Int +offset_StgTSO_blocked_exceptions = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_blocked_exceptions" [] + +{-# NOINLINE offset_StgTSO_bq #-} +offset_StgTSO_bq :: Int +offset_StgTSO_bq = unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_bq" [] + +{-# NOINLINE offset_StgTSO_alloc_limit #-} +offset_StgTSO_alloc_limit :: Int +offset_StgTSO_alloc_limit = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_alloc_limit" [] + +{-# NOINLINE offset_StgTSO_tot_stack_size #-} +offset_StgTSO_tot_stack_size :: Int +offset_StgTSO_tot_stack_size = + unsafePerformIO $ wasmtimeInvoke "offset_StgTSO_tot_stack_size" [] + +{-# NOINLINE offset_StgUpdateFrame_updatee #-} +offset_StgUpdateFrame_updatee :: Int +offset_StgUpdateFrame_updatee = + unsafePerformIO $ wasmtimeInvoke "offset_StgUpdateFrame_updatee" [] + +{-# NOINLINE sizeof_StgWeak #-} +sizeof_StgWeak :: Int +sizeof_StgWeak = unsafePerformIO $ wasmtimeInvoke "sizeof_StgWeak" [] + +{-# NOINLINE offset_StgWeak_cfinalizers #-} +offset_StgWeak_cfinalizers :: Int +offset_StgWeak_cfinalizers = + unsafePerformIO $ wasmtimeInvoke "offset_StgWeak_cfinalizers" [] + +{-# NOINLINE offset_StgWeak_key #-} +offset_StgWeak_key :: Int +offset_StgWeak_key = unsafePerformIO $ wasmtimeInvoke "offset_StgWeak_key" [] + +{-# NOINLINE offset_StgWeak_value #-} +offset_StgWeak_value :: Int +offset_StgWeak_value = + unsafePerformIO $ wasmtimeInvoke "offset_StgWeak_value" [] + +{-# NOINLINE offset_StgWeak_finalizer #-} +offset_StgWeak_finalizer :: Int +offset_StgWeak_finalizer = + unsafePerformIO $ wasmtimeInvoke "offset_StgWeak_finalizer" [] + +{-# NOINLINE offset_StgWeak_link #-} +offset_StgWeak_link :: Int +offset_StgWeak_link = unsafePerformIO $ wasmtimeInvoke "offset_StgWeak_link" [] + +{-# NOINLINE next_ThreadRunGHC #-} +next_ThreadRunGHC :: Int +next_ThreadRunGHC = unsafePerformIO $ wasmtimeInvoke "next_ThreadRunGHC" [] + +{-# NOINLINE next_ThreadInterpret #-} +next_ThreadInterpret :: Int +next_ThreadInterpret = + unsafePerformIO $ wasmtimeInvoke "next_ThreadInterpret" [] + +{-# NOINLINE next_ThreadKilled #-} +next_ThreadKilled :: Int +next_ThreadKilled = unsafePerformIO $ wasmtimeInvoke "next_ThreadKilled" [] + +{-# NOINLINE next_ThreadComplete #-} +next_ThreadComplete :: Int +next_ThreadComplete = unsafePerformIO $ wasmtimeInvoke "next_ThreadComplete" [] + +{-# NOINLINE bf_EVACUATED #-} +bf_EVACUATED :: Int +bf_EVACUATED = unsafePerformIO $ wasmtimeInvoke "bf_EVACUATED" [] + +{-# NOINLINE bf_LARGE #-} +bf_LARGE :: Int +bf_LARGE = unsafePerformIO $ wasmtimeInvoke "bf_LARGE" [] + +{-# NOINLINE bf_PINNED #-} +bf_PINNED :: Int +bf_PINNED = unsafePerformIO $ wasmtimeInvoke "bf_PINNED" [] + +{-# NOINLINE bf_MARKED #-} +bf_MARKED :: Int +bf_MARKED = unsafePerformIO $ wasmtimeInvoke "bf_MARKED" [] + +{-# NOINLINE bf_EXEC #-} +bf_EXEC :: Int +bf_EXEC = unsafePerformIO $ wasmtimeInvoke "bf_EXEC" [] + +{-# NOINLINE bf_FRAGMENTED #-} +bf_FRAGMENTED :: Int +bf_FRAGMENTED = unsafePerformIO $ wasmtimeInvoke "bf_FRAGMENTED" [] + +{-# NOINLINE bf_KNOWN #-} +bf_KNOWN :: Int +bf_KNOWN = unsafePerformIO $ wasmtimeInvoke "bf_KNOWN" [] + +{-# NOINLINE bf_SWEPT #-} +bf_SWEPT :: Int +bf_SWEPT = unsafePerformIO $ wasmtimeInvoke "bf_SWEPT" [] + +{-# NOINLINE bf_COMPACT #-} +bf_COMPACT :: Int +bf_COMPACT = unsafePerformIO $ wasmtimeInvoke "bf_COMPACT" [] + +{-# NOINLINE blocked_NotBlocked #-} +blocked_NotBlocked :: Int +blocked_NotBlocked = unsafePerformIO $ wasmtimeInvoke "blocked_NotBlocked" [] + +{-# NOINLINE blocked_BlockedOnMVar #-} +blocked_BlockedOnMVar :: Int +blocked_BlockedOnMVar = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnMVar" [] + +{-# NOINLINE blocked_BlockedOnMVarRead #-} +blocked_BlockedOnMVarRead :: Int +blocked_BlockedOnMVarRead = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnMVarRead" [] + +{-# NOINLINE blocked_BlockedOnBlackHole #-} +blocked_BlockedOnBlackHole :: Int +blocked_BlockedOnBlackHole = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnBlackHole" [] + +{-# NOINLINE blocked_BlockedOnRead #-} +blocked_BlockedOnRead :: Int +blocked_BlockedOnRead = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnRead" [] + +{-# NOINLINE blocked_BlockedOnWrite #-} +blocked_BlockedOnWrite :: Int +blocked_BlockedOnWrite = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnWrite" [] + +{-# NOINLINE blocked_BlockedOnDelay #-} +blocked_BlockedOnDelay :: Int +blocked_BlockedOnDelay = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnDelay" [] + +{-# NOINLINE blocked_BlockedOnSTM #-} +blocked_BlockedOnSTM :: Int +blocked_BlockedOnSTM = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnSTM" [] + +{-# NOINLINE blocked_BlockedOnDoProc #-} +blocked_BlockedOnDoProc :: Int +blocked_BlockedOnDoProc = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnDoProc" [] + +{-# NOINLINE blocked_BlockedOnCCall #-} +blocked_BlockedOnCCall :: Int +blocked_BlockedOnCCall = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnCCall" [] + +{-# NOINLINE blocked_BlockedOnCCall_Interruptible #-} +blocked_BlockedOnCCall_Interruptible :: Int +blocked_BlockedOnCCall_Interruptible = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnCCall_Interruptible" [] + +{-# NOINLINE blocked_BlockedOnMsgThrowTo #-} +blocked_BlockedOnMsgThrowTo :: Int +blocked_BlockedOnMsgThrowTo = + unsafePerformIO $ wasmtimeInvoke "blocked_BlockedOnMsgThrowTo" [] + +{-# NOINLINE blocked_ThreadMigrating #-} +blocked_ThreadMigrating :: Int +blocked_ThreadMigrating = + unsafePerformIO $ wasmtimeInvoke "blocked_ThreadMigrating" [] + +{-# NOINLINE ret_HeapOverflow #-} +ret_HeapOverflow :: Int +ret_HeapOverflow = unsafePerformIO $ wasmtimeInvoke "ret_HeapOverflow" [] + +{-# NOINLINE ret_StackOverflow #-} +ret_StackOverflow :: Int +ret_StackOverflow = unsafePerformIO $ wasmtimeInvoke "ret_StackOverflow" [] + +{-# NOINLINE ret_ThreadYielding #-} +ret_ThreadYielding :: Int +ret_ThreadYielding = unsafePerformIO $ wasmtimeInvoke "ret_ThreadYielding" [] + +{-# NOINLINE ret_ThreadBlocked #-} +ret_ThreadBlocked :: Int +ret_ThreadBlocked = unsafePerformIO $ wasmtimeInvoke "ret_ThreadBlocked" [] + +{-# NOINLINE ret_ThreadFinished #-} +ret_ThreadFinished :: Int +ret_ThreadFinished = unsafePerformIO $ wasmtimeInvoke "ret_ThreadFinished" [] + +{-# NOINLINE sched_SCHED_RUNNING #-} +sched_SCHED_RUNNING :: Int +sched_SCHED_RUNNING = unsafePerformIO $ wasmtimeInvoke "sched_SCHED_RUNNING" [] + +{-# NOINLINE sched_SCHED_INTERRUPTING #-} +sched_SCHED_INTERRUPTING :: Int +sched_SCHED_INTERRUPTING = + unsafePerformIO $ wasmtimeInvoke "sched_SCHED_INTERRUPTING" [] + +{-# NOINLINE sched_SCHED_SHUTTING_DOWN #-} +sched_SCHED_SHUTTING_DOWN :: Int +sched_SCHED_SHUTTING_DOWN = + unsafePerformIO $ wasmtimeInvoke "sched_SCHED_SHUTTING_DOWN" [] + +{-# NOINLINE scheduler_NoStatus #-} +scheduler_NoStatus :: Int +scheduler_NoStatus = unsafePerformIO $ wasmtimeInvoke "scheduler_NoStatus" [] + +{-# NOINLINE scheduler_Success #-} +scheduler_Success :: Int +scheduler_Success = unsafePerformIO $ wasmtimeInvoke "scheduler_Success" [] + +{-# NOINLINE scheduler_Killed #-} +scheduler_Killed :: Int +scheduler_Killed = unsafePerformIO $ wasmtimeInvoke "scheduler_Killed" [] + +{-# NOINLINE scheduler_Interrupted #-} +scheduler_Interrupted :: Int +scheduler_Interrupted = + unsafePerformIO $ wasmtimeInvoke "scheduler_Interrupted" [] + +{-# NOINLINE scheduler_HeapExhausted #-} +scheduler_HeapExhausted :: Int +scheduler_HeapExhausted = + unsafePerformIO $ wasmtimeInvoke "scheduler_HeapExhausted" [] + +{-# NOINLINE sizeof_bool #-} +sizeof_bool :: Int +sizeof_bool = unsafePerformIO $ wasmtimeInvoke "sizeof_bool" [] + +{-# NOINLINE sizeof_int #-} +sizeof_int :: Int +sizeof_int = unsafePerformIO $ wasmtimeInvoke "sizeof_int" [] + +{-# NOINLINE sizeof_SchedulerStatus #-} +sizeof_SchedulerStatus :: Int +sizeof_SchedulerStatus = + unsafePerformIO $ wasmtimeInvoke "sizeof_SchedulerStatus" [] + +{-# NOINLINE tso_LOCKED #-} +tso_LOCKED :: Int +tso_LOCKED = unsafePerformIO $ wasmtimeInvoke "tso_LOCKED" [] + +{-# NOINLINE tso_BLOCKEX #-} +tso_BLOCKEX :: Int +tso_BLOCKEX = unsafePerformIO $ wasmtimeInvoke "tso_BLOCKEX" [] + +{-# NOINLINE tso_INTERRUPTIBLE #-} +tso_INTERRUPTIBLE :: Int +tso_INTERRUPTIBLE = unsafePerformIO $ wasmtimeInvoke "tso_INTERRUPTIBLE" [] + +{-# NOINLINE tso_STOPPED_ON_BREAKPOINT #-} +tso_STOPPED_ON_BREAKPOINT :: Int +tso_STOPPED_ON_BREAKPOINT = + unsafePerformIO $ wasmtimeInvoke "tso_STOPPED_ON_BREAKPOINT" [] + +{-# NOINLINE tso_MARKED #-} +tso_MARKED :: Int +tso_MARKED = unsafePerformIO $ wasmtimeInvoke "tso_MARKED" [] + +{-# NOINLINE tso_SQUEEZED #-} +tso_SQUEEZED :: Int +tso_SQUEEZED = unsafePerformIO $ wasmtimeInvoke "tso_SQUEEZED" [] + +{-# NOINLINE tso_ALLOC_LIMIT #-} +tso_ALLOC_LIMIT :: Int +tso_ALLOC_LIMIT = unsafePerformIO $ wasmtimeInvoke "tso_ALLOC_LIMIT" [] + +{-# NOINLINE sizeof_StgStableName #-} +sizeof_StgStableName :: Int +sizeof_StgStableName = + unsafePerformIO $ wasmtimeInvoke "sizeof_StgStableName" [] + +{-# NOINLINE offset_StgStableName_header #-} +offset_StgStableName_header :: Int +offset_StgStableName_header = + unsafePerformIO $ wasmtimeInvoke "offset_StgStableName_header" [] + +{-# NOINLINE offset_StgStableName_sn #-} +offset_StgStableName_sn :: Int +offset_StgStableName_sn = + unsafePerformIO $ wasmtimeInvoke "offset_StgStableName_sn" [] + +{-# NOINLINE clock_monotonic #-} +clock_monotonic :: Int +clock_monotonic = unsafePerformIO $ wasmtimeInvoke "clock_monotonic" [] + +{-# NOINLINE clock_realtime #-} +clock_realtime :: Int +clock_realtime = unsafePerformIO $ wasmtimeInvoke "clock_realtime" [] diff --git a/cabal.project.nix b/nix.cabal.project similarity index 79% rename from cabal.project.nix rename to nix.cabal.project index e48a876b..a380a9b0 100644 --- a/cabal.project.nix +++ b/nix.cabal.project @@ -11,7 +11,7 @@ source-repository-package source-repository-package type: git location: https://github.com/tweag/ghc-asterius.git - tag: bf758f1f98aab4f3267261bbeb91a18fa2e8de07 + tag: f5d7ac185adcb058f71aa721e86cd98eace063d7 subdir: ahc-bin ahc-pkg @@ -22,11 +22,5 @@ source-repository-package ghci-asterius template-haskell-asterius -package aeson - flags: +cffi - package binaryen flags: +system-binaryen - -package hashable - flags: +random-initial-seed diff --git a/nix/ghcconstants.nix b/nix/ghcconstants.nix new file mode 100644 index 00000000..71b04183 --- /dev/null +++ b/nix/ghcconstants.nix @@ -0,0 +1,27 @@ +{ sources ? import ./sources.nix { } +, haskellNix ? import sources.haskell-nix { } +, pkgs ? import haskellNix.sources.nixpkgs-unstable { } }: +let + ghc_asterius = import "${sources.ghc-asterius}/nix/src-32.nix" { }; + wasi-sdk = import "${sources.wasi-sdk}/nix/default.nix" { }; +in +pkgs.callPackage + ({ stdenv, stdenvNoCC }: + stdenvNoCC.mkDerivation ({ + name = "ghcconstants"; + src = ../ghc-toolkit/cbits; + installPhase = '' + mkdir -p $out/bin + $CC \ + -Wall \ + -Wextra \ + -I${ghc_asterius}/ghc-asterius/autogen \ + -mexec-model=reactor \ + -o $out/bin/ghcconstants.wasm \ + ghc_constants.c + ''; + allowedReferences = [ ]; + } // (import "${sources.ghc-asterius}/nix/wasi-sdk-stdenv.nix" { + inherit stdenv wasi-sdk; + }))) +{ } diff --git a/nix/libghcconstants.nix b/nix/libghcconstants.nix deleted file mode 100644 index 0f2392b9..00000000 --- a/nix/libghcconstants.nix +++ /dev/null @@ -1,17 +0,0 @@ -let - sources = import ./sources.nix { }; - ghc_asterius = import "${sources.ghc-asterius}/nix/src.nix" { }; -in -self: super: { - ghcconstants = self.callPackage - ({ stdenv }: - stdenv.mkDerivation { - name = "libghcconstants"; - src = ../ghc-toolkit/cbits; - installPhase = '' - mkdir -p $out/lib - $CC -I${ghc_asterius}/ghc-asterius/autogen -O3 -o $out/lib/libghcconstants.so -shared ghc_constants.c - ''; - }) - { }; -} diff --git a/nix/pkg-set.nix b/nix/project.nix similarity index 63% rename from nix/pkg-set.nix rename to nix/project.nix index 1cfdc78e..01aa7032 100644 --- a/nix/pkg-set.nix +++ b/nix/project.nix @@ -1,26 +1,22 @@ { sources ? import ./sources.nix { } , haskellNix ? import sources.haskell-nix { } -, pkgs ? import sources.nixpkgs +, pkgs ? import haskellNix.sources.nixpkgs-unstable (haskellNix.nixpkgsArgs // { overlays = haskellNix.nixpkgsArgs.overlays - ++ [ (import ./binaryen.nix) (import ./libghcconstants.nix) ]; + ++ [ (import ./binaryen.nix) ]; }) , ghc ? "ghc8107" }: pkgs.callPackage - ({ callPackage, haskell-nix, nodejs_latest }: + ({ haskell-nix, nodejs_latest }: haskell-nix.cabalProject rec { src = haskell-nix.haskellLib.cleanGit { name = "asterius_src"; src = ../.; }; - cabalProject = builtins.readFile "${src}/cabal.project.nix"; + cabalProject = builtins.readFile "${src}/nix.cabal.project"; compiler-nix-name = ghc; modules = [ - { configureFlags = [ "-O2" ]; } - { dontPatchELF = false; } - { dontStrip = false; } - { hardeningDisable = [ "all" ]; } { packages.inline-js-core.preConfigure = '' substituteInPlace src/Language/JavaScript/Inline/Core/NodePath.hs --replace '"node"' '"${nodejs_latest}/bin/node"' diff --git a/nix/sources.json b/nix/sources.json index fd39b73f..5f3b39e5 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -1,9 +1,9 @@ { "ghc-asterius": { - "branch": "asterius-8.10", + "branch": "asterius-8.10-dejavu", "repo": "https://github.com/tweag/ghc-asterius.git", - "rev": "1388aa804ebb0f642d5ea86fe03a9ba1a3cb06c0", - "sha256": "0njav5q5bnl6jk9p6hy30hdb6bmp48fjq15m31ymvrvmfich850j", + "rev": "cff0d004bc7258568cdd43bb889b384ac1de22f1", + "sha256": "1qy2dpqjynzjpy6n879qb5dmwg7mxldglw6many99xn2zc8lkpj8", "type": "git" }, "haskell-nix": { @@ -12,10 +12,10 @@ "homepage": "https://input-output-hk.github.io/haskell.nix", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "9a72ca634abc2b68d6a1a468130fd4503b3ad7ea", - "sha256": "1ivii52ldnj39y59rm68mj4nq3y5xasdv3hw3lib5r42pdyc0f8p", + "rev": "d231ee71dc511806ff75a6d83c7481fa25bbf8fe", + "sha256": "07jnklzcki5m2lz5bv4yllgmwkwyplcsvbhfr92dgv9g8dlnwbg1", "type": "tarball", - "url": "https://github.com/input-output-hk/haskell.nix/archive/9a72ca634abc2b68d6a1a468130fd4503b3ad7ea.tar.gz", + "url": "https://github.com/input-output-hk/haskell.nix/archive/d231ee71dc511806ff75a6d83c7481fa25bbf8fe.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "hs-nix-tools": { @@ -24,29 +24,17 @@ "homepage": null, "owner": "TerrorJack", "repo": "hs-nix-tools", - "rev": "a922abb7ecffa678c830dd3198a422787d156f0f", - "sha256": "1waj70r475kha8wyk6fk729ai21hqykc1phw0vsvyjy5h3l43ywx", + "rev": "c674bc038d151bb41fe2570b1af0558014859f41", + "sha256": "0s2jdr921g4r6zb96ms5y83fn30hnh3pil2d5lqikcrndijkkap8", "type": "tarball", - "url": "https://github.com/TerrorJack/hs-nix-tools/archive/a922abb7ecffa678c830dd3198a422787d156f0f.tar.gz", - "url_template": "https://github.com///archive/.tar.gz" - }, - "nixpkgs": { - "branch": "nixos-unstable", - "description": "Nix Packages collection", - "homepage": "", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "5f0194220f2402b06f7f79bba6351895facb5acb", - "sha256": "0h2j0ivbp3b84d38h8s06s2yvnwqy80f4i1a75jd11m45m804n3s", - "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/5f0194220f2402b06f7f79bba6351895facb5acb.tar.gz", + "url": "https://github.com/TerrorJack/hs-nix-tools/archive/c674bc038d151bb41fe2570b1af0558014859f41.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "wasi-sdk": { - "branch": "main", + "branch": "dejavu", "repo": "https://github.com/tweag/wasi-sdk.git", - "rev": "7164b36d8204b2b0360739bd502baba543cbae0f", - "sha256": "1chm44qjcn06mp6npn8r5k475cz677k8fqpiijddzavd8vjcnp7c", + "rev": "f88568a3e729ec5b803b4413ae71fdb8c6b4bf4c", + "sha256": "1hxyrfwml0gs2gmqm7n29am759r87cvv5w08xqi9x2g49rv8b0rd", "type": "git" } } diff --git a/nix/sources.nix b/nix/sources.nix index 1343b69f..5499fa4a 100644 --- a/nix/sources.nix +++ b/nix/sources.nix @@ -53,22 +53,7 @@ let # The set of packages used when specs are fetched using non-builtins. mkPkgs = sources: system: - let - sourcesNixpkgs = - import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; }; - hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; - hasThisAsNixpkgsPath = == ./.; - in - if builtins.hasAttr "nixpkgs" sources - then sourcesNixpkgs - else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then - import {} - else - abort - '' - Please specify either (through -I or NIX_PATH=nixpkgs=...) or - add a package called "nixpkgs" to your sources.json. - ''; + import (import (builtins_fetchTarball { inherit (sources.haskell-nix) url sha256; }) { }).sources.nixpkgs-unstable { inherit system; }; # The actual fetching function. fetch = pkgs: name: spec: diff --git a/shell.nix b/shell.nix index a49cdbf2..f092b2ec 100644 --- a/shell.nix +++ b/shell.nix @@ -1,14 +1,13 @@ { sources ? import ./nix/sources.nix { } , haskellNix ? import sources.haskell-nix { } -, pkgs ? import sources.nixpkgs +, pkgs ? import haskellNix.sources.nixpkgs-unstable (haskellNix.nixpkgsArgs // { overlays = haskellNix.nixpkgsArgs.overlays ++ [ (import ./nix/binaryen.nix) - (import ./nix/libghcconstants.nix) ]; }) , ghc ? "ghc8107" -, hsPkgs ? pkgs.callPackage ./nix/pkg-set.nix { inherit pkgs ghc; } +, hsPkgs ? import ./nix/project.nix { inherit pkgs ghc; } }: (hsPkgs.shellFor rec { packages = ps: with ps; [ asterius ghc-toolkit ]; @@ -37,14 +36,14 @@ let p = import "${sources.ghc-asterius}/nix/wasi-rts.nix" { }; in "${p}/bin/rts.wasm"; - LD_LIBRARY_PATH = pkgs.lib.makeLibraryPath [ pkgs.ghcconstants ]; - WASI_SDK_PREFIX = import "${sources.wasi-sdk}/nix/default.nix" { }; - GHC_ASTERIUS = import "${sources.ghc-asterius}/nix/src.nix" { }; + GHC_ASTERIUS = import "${sources.ghc-asterius}/nix/src-32.nix" { }; GHC_ASTERIUS_BOOT = GHC_ASTERIUS.boot; + AHC_CONSTANTS = let p = import ./nix/ghcconstants.nix {}; in "${p}/bin/ghcconstants.wasm"; + shellHook = '' taskset -pc 0-1000 $$