mirror of
https://github.com/tweag/asterius.git
synced 2024-10-26 09:21:04 +03:00
32-bit codegen (#876)
This commit is contained in:
parent
d7d6eeeab1
commit
e4791671dc
5
.github/workflows/shell.yml
vendored
5
.github/workflows/shell.yml
vendored
@ -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: |
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -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,
|
||||
];
|
||||
|
@ -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"];
|
||||
|
@ -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:
|
||||
|
@ -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));
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -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(
|
||||
|
@ -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")
|
||||
);
|
||||
|
@ -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) {
|
||||
|
@ -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);
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
@ -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);
|
||||
}
|
||||
|
||||
|
9
asterius/rts/rts.typecheck.mjs
Normal file
9
asterius/rts/rts.typecheck.mjs
Normal file
@ -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;
|
||||
}
|
@ -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
|
||||
|
@ -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 $
|
||||
|
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -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]
|
||||
|
@ -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 = []}
|
||||
|
@ -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"
|
||||
|
@ -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]
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 = []}
|
||||
}
|
||||
|
@ -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"
|
||||
}
|
||||
),
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -1,7 +1,4 @@
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE UnboxedTuples #-}
|
||||
|
||||
module Asterius.Internals
|
||||
( encodeStorable,
|
||||
|
@ -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)
|
||||
|
@ -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.
|
||||
|
@ -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 = []
|
||||
|
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Asterius.JSRun.NonMain
|
||||
( distNonMain,
|
||||
|
@ -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
|
||||
|
@ -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",
|
||||
|
@ -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
|
||||
],
|
||||
|
@ -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
|
||||
}
|
||||
|
@ -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
|
||||
|
||||
|
@ -1,8 +1,6 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Asterius.Passes.GCSections
|
||||
|
@ -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
|
||||
}
|
||||
|
111
asterius/src/Asterius/Passes/Relooper.hs
Normal file
111
asterius/src/Asterius/Passes/Relooper.hs
Normal file
@ -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 = []
|
||||
}
|
@ -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 =
|
||||
|
@ -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)
|
||||
|
@ -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; }
|
||||
|
@ -24,7 +24,6 @@ dependencies:
|
||||
- process
|
||||
|
||||
library:
|
||||
extra-libraries: ghcconstants
|
||||
source-dirs: src
|
||||
other-extensions:
|
||||
- DuplicateRecordFields
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -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
|
27
nix/ghcconstants.nix
Normal file
27
nix/ghcconstants.nix
Normal file
@ -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;
|
||||
})))
|
||||
{ }
|
@ -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
|
||||
'';
|
||||
})
|
||||
{ };
|
||||
}
|
@ -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"'
|
@ -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/<owner>/<repo>/archive/<rev>.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/<owner>/<repo>/archive/<rev>.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/<owner>/<repo>/archive/<rev>.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"
|
||||
}
|
||||
}
|
||||
|
@ -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 = <nixpkgs> == ./.;
|
||||
in
|
||||
if builtins.hasAttr "nixpkgs" sources
|
||||
then sourcesNixpkgs
|
||||
else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then
|
||||
import <nixpkgs> {}
|
||||
else
|
||||
abort
|
||||
''
|
||||
Please specify either <nixpkgs> (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:
|
||||
|
11
shell.nix
11
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 $$
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user