[Git][ghc/ghc][wip/ghc-internals-move-2] 2 commits: Linker javascript
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Feb 7 16:15:01 UTC 2024
Matthew Pickering pushed to branch wip/ghc-internals-move-2 at Glasgow Haskell Compiler / GHC
Commits:
710d3bb4 by GHC GitLab CI at 2024-02-07T16:14:18+00:00
Linker javascript
- - - - -
48816290 by GHC GitLab CI at 2024-02-07T16:14:45+00:00
JS
- - - - -
9 changed files:
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/StgToJS/Types.hs
- rts/js/environment.js
- rts/js/gc.js
- rts/js/mem.js
- rts/js/rts.js
- rts/js/thread.js
Changes:
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -328,7 +328,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache = do
let obj_roots = S.fromList . filter obj_is_root $ concatMap (M.keys . bi_exports . lbi_info) (M.elems objs_block_info)
obj_units = map moduleUnitId $ nub (M.keys objs_block_info)
- let (rts_wired_units, rts_wired_functions) = rtsDeps units
+ let (rts_wired_units, rts_wired_functions) = rtsDeps
-- all the units we want to link together, without their dependencies
let root_units = filter (/= ue_currentUnit unit_env)
@@ -818,8 +818,8 @@ diffDeps pkgs (deps_pkgs,deps_funs) =
linked_pkgs = S.fromList pkgs
-- | dependencies for the RTS, these need to be always linked
-rtsDeps :: [UnitId] -> ([UnitId], Set ExportedFun)
-rtsDeps pkgs = diffDeps pkgs $
+rtsDeps :: ([UnitId], Set ExportedFun)
+rtsDeps =
( [ghcInternalUnitId, primUnitId]
, S.fromList $ concat
[ mkInternalFuns "GHC.Conc.Sync"
=====================================
compiler/GHC/StgToJS/Linker/Utils.hs
=====================================
@@ -122,41 +122,41 @@ genCommonCppDefs profiling = mconcat
-- GHCJS.Prim.JSVal
, if profiling
- then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n"
- else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n"
+ then "#define MK_JSVAL(x) (h$c1(h$ghczminternalZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n"
+ else "#define MK_JSVAL(x) (h$c1(h$ghczminternalZCGHCziJSziPrimziJSVal_con_e, (x)))\n"
, "#define JSVAL_VAL(x) ((x).d1)\n"
-- GHCJS.Prim.JSException
, if profiling
- then "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM))\n"
- else "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg)))\n"
+ then "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghczminternalZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM))\n"
+ else "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghczminternalZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg)))\n"
-- Exception dictionary for JSException
- , "#define HS_JSEXCEPTION_EXCEPTION h$baseZCGHCziJSziPrimzizdfExceptionJSException\n"
+ , "#define HS_JSEXCEPTION_EXCEPTION h$ghczminternalZCGHCziJSziPrimzizdfExceptionJSException\n"
-- SomeException
, if profiling
- then "#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$baseZCGHCziExceptionziTypeziSomeException_con_e,(dict),(except),h$CCS_SYSTEM))\n"
- else "#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$baseZCGHCziExceptionziTypeziSomeException_con_e,(dict),(except)))\n"
+ then "#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$ghczminternalZCGHCziExceptionziTypeziSomeException_con_e,(dict),(except),h$CCS_SYSTEM))\n"
+ else "#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$ghczminternalZCGHCziExceptionziTypeziSomeException_con_e,(dict),(except)))\n"
-- GHC.Ptr.Ptr
, if profiling
- then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n"
- else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n"
+ then "#define MK_PTR(val,offset) (h$c2(h$ghczminternalZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n"
+ else "#define MK_PTR(val,offset) (h$c2(h$ghczminternalZCGHCziPtrziPtr_con_e, (val), (offset)))\n"
-- Put Addr# in ByteArray# or at Addr# (same thing)
, "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n"
, "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n"
-- Data.Maybe.Maybe
- , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n"
- , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n"
- , "#define IS_JUST(cl) ((cl).f === h$baseZCGHCziMaybeziJust_con_e)\n"
+ , "#define HS_NOTHING h$ghczminternalZCGHCziMaybeziNothing\n"
+ , "#define IS_NOTHING(cl) ((cl).f === h$ghczminternalZCGHCziMaybeziNothing_con_e)\n"
+ , "#define IS_JUST(cl) ((cl).f === h$ghczminternalZCGHCziMaybeziJust_con_e)\n"
, "#define JUST_VAL(jj) ((jj).d1)\n"
-- "#define HS_NOTHING h$nothing\n"
, if profiling
- then "#define MK_JUST(val) (h$c1(h$baseZCGHCziMaybeziJust_con_e, (val), h$CCS_SYSTEM))\n"
- else "#define MK_JUST(val) (h$c1(h$baseZCGHCziMaybeziJust_con_e, (val)))\n"
+ then "#define MK_JUST(val) (h$c1(h$ghczminternalZCGHCziMaybeziJust_con_e, (val), h$CCS_SYSTEM))\n"
+ else "#define MK_JUST(val) (h$c1(h$ghczminternalZCGHCziMaybeziJust_con_e, (val)))\n"
-- Data.List
, "#define HS_NIL h$ghczmprimZCGHCziTypesziZMZN\n"
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -898,9 +898,9 @@ genPrim prof bound ty op = case op of
-- slots, depending on the return type.
RaiseOp -> \_r [a] -> pure $ PRPrimCall $ returnS (app "h$throw" [a, false_])
RaiseIOOp -> \_r [a] -> pure $ PRPrimCall $ returnS (app "h$throw" [a, false_])
- RaiseUnderflowOp -> \_r [] -> pure $ PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypeziunderflowException", false_])
- RaiseOverflowOp -> \_r [] -> pure $ PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezioverflowException", false_])
- RaiseDivZeroOp -> \_r [] -> pure $ PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezidivZZeroException", false_])
+ RaiseUnderflowOp -> \_r [] -> pure $ PRPrimCall $ returnS (app "h$throw" [var "h$ghczminternalZCGHCziExceptionziTypeziunderflowException", false_])
+ RaiseOverflowOp -> \_r [] -> pure $ PRPrimCall $ returnS (app "h$throw" [var "h$ghczminternalZCGHCziExceptionziTypezioverflowException", false_])
+ RaiseDivZeroOp -> \_r [] -> pure $ PRPrimCall $ returnS (app "h$throw" [var "h$ghczminternalZCGHCziExceptionziTypezidivZZeroException", false_])
MaskAsyncExceptionsOp -> \_r [a] -> pure $ PRPrimCall $ returnS (app "h$maskAsync" [a])
MaskUninterruptibleOp -> \_r [a] -> pure $ PRPrimCall $ returnS (app "h$maskUnintAsync" [a])
UnmaskAsyncExceptionsOp -> \_r [a] -> pure $ PRPrimCall $ returnS (app "h$unmaskAsync" [a])
=====================================
compiler/GHC/StgToJS/Types.hs
=====================================
@@ -170,14 +170,14 @@ instance ToJExpr JSRep where
-- in JS Land. For example, the entry function for the 'Just' constructor is a
-- 'IdConEntry' which compiles to:
-- @
--- function h$baseZCGHCziMaybeziJust_con_e() { return h$rs() };
+-- function h$ghczminternalZCGHCziMaybeziJust_con_e() { return h$rs() };
-- @
-- which just returns whatever the stack point is pointing to. Whereas the entry
-- function to 'Just' is an 'IdEntry' and does the work. It compiles to:
-- @
--- function h$baseZCGHCziMaybeziJust_e() {
+-- function h$ghczminternalZCGHCziMaybeziJust_e() {
-- var h$$baseZCGHCziMaybezieta_8KXnScrCjF5 = h$r2;
--- h$r1 = h$c1(h$baseZCGHCziMaybeziJust_con_e, h$$baseZCGHCziMaybezieta_8KXnScrCjF5);
+-- h$r1 = h$c1(h$ghczminternalZCGHCziMaybeziJust_con_e, h$$baseZCGHCziMaybezieta_8KXnScrCjF5);
-- return h$rs();
-- };
-- @
=====================================
rts/js/environment.js
=====================================
@@ -390,7 +390,7 @@ function h$performMajorGC() {
}
-function h$baseZCSystemziCPUTimeZCgetrusage() {
+function h$ghczminternalZCSystemziCPUTimeZCgetrusage() {
return 0;
}
=====================================
rts/js/gc.js
=====================================
@@ -592,11 +592,11 @@ function h$resolveDeadlocks() {
// blocked on MVar
if(bo.m === mark) throw "assertion failed: thread should have been marked";
// MVar unreachable
- kill = h$baseZCGHCziJSziPrimziInternalziblockedIndefinitelyOnMVar;
+ kill = h$ghczminternalZCGHCziJSziPrimziInternalziblockedIndefinitelyOnMVar;
break;
} else if(t.blockedOn instanceof h$TVarsWaiting) {
// blocked in STM transaction
- kill = h$baseZCGHCziJSziPrimziInternalziblockedIndefinitelyOnSTM;
+ kill = h$ghczminternalZCGHCziJSziPrimziInternalziblockedIndefinitelyOnSTM;
break;
} else {
// blocked on something else, we can't do anything
=====================================
rts/js/mem.js
=====================================
@@ -71,9 +71,9 @@ function h$stl(o, xs, t) {
// #endif
// #ifdef GHCJS_PROF
-// var h$nothing = h$c(h$baseZCGHCziBaseziNothing_con_e, h$CCS_SYSTEM);
+// var h$nothing = h$c(h$ghczminternalZCGHCziBaseziNothing_con_e, h$CCS_SYSTEM);
// #else
-//var h$nothing = h$c(h$baseZCGHCziBaseziNothing_con_e);
+//var h$nothing = h$c(h$ghczminternalZCGHCziBaseziNothing_con_e);
// #endif
// delayed init for top-level closures
=====================================
rts/js/rts.js
=====================================
@@ -4,7 +4,7 @@ var h$start = new Date();
function h$rts_eval(action, unbox) {
return new Promise((accept, reject) =>
- h$run(MK_AP3( h$baseZCGHCziJSziPrimziresolveIO
+ h$run(MK_AP3( h$ghczminternalZCGHCziJSziPrimziresolveIO
, x => { accept(unbox(x))}
, e => { reject(new h$HaskellException(e))}
, action
@@ -15,7 +15,7 @@ function h$rts_eval(action, unbox) {
function h$rts_eval_sync(closure, unbox) {
var res, status = 0;
try {
- h$runSync(MK_AP3( h$baseZCGHCziJSziPrimziresolveIO
+ h$runSync(MK_AP3( h$ghczminternalZCGHCziJSziPrimziresolveIO
, x => { status = 1; res = unbox(x); }
, e => { status = 2; res = new h$HaskellException(e); }
, closure), false);
@@ -150,7 +150,7 @@ function h$rts_getFunPtr(x) {
}
function h$rts_toIO(x) {
- return MK_AP1(h$baseZCGHCziJSziPrimzitoIO, x);
+ return MK_AP1(h$ghczminternalZCGHCziJSziPrimzitoIO, x);
}
// running IO actions
=====================================
rts/js/thread.js
=====================================
@@ -70,7 +70,7 @@ var h$blocked = new h$Set();
function h$Thread() {
this.tid = ++h$threadIdN;
this.status = THREAD_RUNNING;
- this.stack = [h$done, 0, h$baseZCGHCziConcziSynczireportError, h$catch_e];
+ this.stack = [h$done, 0, h$ghczminternalZCGHCziConcziSynczireportError, h$catch_e];
#ifdef GHCJS_DEBUG_STACK
this.stack = new Proxy(this.stack, {
set(obj,prop,value) {
@@ -878,7 +878,7 @@ function h$handleBlockedSyncThread(c) {
TRACE_SCHEDULER("blocking synchronous thread: exception")
h$sp += 2;
h$currentThread.sp = h$sp;
- h$stack[h$sp-1] = h$baseZCGHCziJSziPrimziInternalziwouldBlock;
+ h$stack[h$sp-1] = h$ghczminternalZCGHCziJSziPrimziInternalziwouldBlock;
h$stack[h$sp] = h$raiseAsync_frame;
h$forceWakeupThread(h$currentThread);
c = h$raiseAsync_frame;
@@ -950,7 +950,7 @@ function h$setCurrentThreadResultValue(v) {
function h$runSyncReturn(a, cont) {
var t = new h$Thread();
TRACE_SCHEDULER("h$runSyncReturn created thread: " + h$threadString(t))
- var aa = MK_AP1(h$baseZCGHCziJSziPrimziInternalzisetCurrentThreadResultValue, a);
+ var aa = MK_AP1(h$ghczminternalZCGHCziJSziPrimziInternalzisetCurrentThreadResultValue, a);
h$runSyncAction(t, aa, cont);
if(t.status === THREAD_FINISHED) {
if(t.resultIsException) {
@@ -993,7 +993,7 @@ function h$runSync(a, cont) {
function h$runSyncAction(t, a, cont) {
h$runInitStatic();
var c = h$return;
- t.stack[2] = h$baseZCGHCziJSziPrimziInternalzisetCurrentThreadResultException;
+ t.stack[2] = h$ghczminternalZCGHCziJSziPrimziInternalzisetCurrentThreadResultException;
t.stack[4] = h$ap_1_0;
t.stack[5] = a;
t.stack[6] = h$return;
@@ -1147,7 +1147,7 @@ function h$main(a) {
t.stack[0] = h$doneMain_e;
#ifndef GHCJS_BROWSER
if(!h$isBrowser() && !h$isGHCJSi()) {
- t.stack[2] = h$baseZCGHCziTopHandlerzitopHandler;
+ t.stack[2] = h$ghczminternalZCGHCziTopHandlerzitopHandler;
}
#endif
t.stack[4] = h$ap_1_0;
@@ -1392,7 +1392,7 @@ function h$blockOnBlackhole(c) {
TRACE_SCHEDULER("blackhole, blocking: " + h$collectProps(c))
if(BLACKHOLE_TID(c) === h$currentThread) {
TRACE_SCHEDULER("NonTermination")
- return h$throw(h$baseZCControlziExceptionziBasezinonTermination, true);
+ return h$throw(h$ghczminternalZCControlziExceptionziBasezinonTermination, true);
}
TRACE_SCHEDULER("blackhole, blocking thread: " + h$threadString(h$currentThread))
if(BLACKHOLE_QUEUE(c) === null) {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c94dfa04f17f04d34369956f2f1f1697cb48382...488162904240587b2006cfc64f45fe47a2e569ce
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c94dfa04f17f04d34369956f2f1f1697cb48382...488162904240587b2006cfc64f45fe47a2e569ce
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240207/ac975f6f/attachment-0001.html>
More information about the ghc-commits
mailing list