tweag/asterius
1
1
Fork 0
mirror of https://github.com/tweag/asterius.git synced 2024-10-26 09:21:04 +03:00
Code Issues Projects Releases Wiki Activity

32-bit codegen (#876)

Browse Source
This commit is contained in:
Cheng Shao 2021-12-04 02:24:56 +01:00 committed by GitHub
parent d7d6eeeab1
commit e4791671dc
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
59 changed files with 2827 additions and 2582 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.github/workflows/shell.yml vendored
View File

@ -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: |

62
asterius/boot.sh
View File

@ -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

3
asterius/package.yaml
View File

@ -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

15
asterius/rts/node/rts.fs.mjs
View File

@ -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));
}
}
}

31
asterius/rts/rts.autoapply.mjs
View File

@ -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,
];

162
asterius/rts/rts.constants.mjs
View File

@ -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"];

53
asterius/rts/rts.exception.mjs
View File

@ -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:

272
asterius/rts/rts.gc.mjs
View File

@ -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));
}
}

31
asterius/rts/rts.heapalloc.mjs
View File

@ -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(

2
asterius/rts/rts.jsval.mjs
View File

@ -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")
);

30
asterius/rts/rts.memory.mjs
View File

@ -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) {

40
asterius/rts/rts.memorytrap.mjs
View File

@ -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);
}

54
asterius/rts/rts.scheduler.mjs
View File

@ -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

10
asterius/rts/rts.stablename.mjs
View File

@ -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);
}
}

9
asterius/rts/rts.stableptr.mjs
View File

@ -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
View 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;
}

10
asterius/src-types/Asterius/Types.hs
View File

@ -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

29
asterius/src/Asterius/Backends/Binaryen.hs
View File

@ -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 $

2
asterius/src/Asterius/Binary/File.hs
View File

@ -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

669
asterius/src/Asterius/Builtins.hs
View File

File diff suppressed because it is too large Load Diff

14
asterius/src/Asterius/Builtins/Barf.hs
View File

@ -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]

68
asterius/src/Asterius/Builtins/Blackhole.hs
View File

@ -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 = []}

11
asterius/src/Asterius/Builtins/Env.hs
View File

@ -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"

31
asterius/src/Asterius/Builtins/Exports.hs
View File

@ -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]

259
asterius/src/Asterius/Builtins/Posix.hs
View File

@ -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

36
asterius/src/Asterius/Builtins/SM.hs
View File

@ -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

14
asterius/src/Asterius/Builtins/Scheduler.hs
View File

@ -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)

6
asterius/src/Asterius/Builtins/Sparks.hs
View File

@ -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

88
asterius/src/Asterius/Builtins/Time.hs
View File

@ -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

416
asterius/src/Asterius/CodeGen.hs
View File

@ -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

8
asterius/src/Asterius/EDSL.hs
View File

@ -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 = []}
}

6
asterius/src/Asterius/Foreign/SupportedTypes.hs
View File

@ -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"
}
),

13
asterius/src/Asterius/FrontendPlugin.hs
View File

@ -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

1
asterius/src/Asterius/GHCi/Internals.hs
View File

@ -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

3
asterius/src/Asterius/Internals.hs
View File

@ -1,7 +1,4 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnboxedTuples #-}
module Asterius.Internals
( encodeStorable,

6
asterius/src/Asterius/Internals/MagicNumber.hs
View File

@ -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)

1
asterius/src/Asterius/Internals/Temp.hs
View File

@ -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.

56
asterius/src/Asterius/JSFFI.hs
View File

@ -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
asterius/src/Asterius/JSRun/NonMain.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Asterius.JSRun.NonMain
( distNonMain,

5
asterius/src/Asterius/Main.hs
View File

@ -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

4
asterius/src/Asterius/Main/Task.hs
View File

@ -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",

12
asterius/src/Asterius/MemoryTrap.hs
View File

@ -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
],

13
asterius/src/Asterius/Passes/CCall.hs
View File

@ -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
}

4
asterius/src/Asterius/Passes/DataOffsetTable.hs
View File

@ -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

2
asterius/src/Asterius/Passes/GCSections.hs
View File

@ -1,8 +1,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Asterius.Passes.GCSections

50
asterius/src/Asterius/Passes/GlobalRegs.hs
View File

@ -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
View 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 = []
}

5
asterius/src/Asterius/Resolve.hs
View File

@ -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 =

10
asterius/src/Asterius/TypeInfer.hs
View File

@ -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)

817
ghc-toolkit/cbits/ghc_constants.c
View File

@ -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; }

1
ghc-toolkit/package.yaml
View File

@ -24,7 +24,6 @@ dependencies:
- process
library:
extra-libraries: ghcconstants
source-dirs: src
other-extensions:
- DuplicateRecordFields

1711
ghc-toolkit/src/Language/Haskell/GHC/Toolkit/Constants.hs
View File

File diff suppressed because it is too large Load Diff

8
cabal.project.nix → nix.cabal.project
View File

@ -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
View 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;
})))
{ }

17
nix/libghcconstants.nix
View File

@ -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
'';
})
{ };
}

12
nix/pkg-set.nix → nix/project.nix
View File

@ -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"'

36
nix/sources.json
View File

@ -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"
}
}

17
nix/sources.nix
View File

@ -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
View File

@ -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 $$