summaryrefslogtreecommitdiff
path: root/rts
diff options
context:
space:
mode:
authorCheng Shao <cheng.shao@tweag.io>2021-01-18 11:23:41 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-01-22 15:06:00 -0500
commit532337cb8181f31bd4a5475b2dc9740d428657b5 (patch)
treeff2d7e48a43bf57c13b95315ee0e7ed79e1f9b31 /rts
parent637ae302bf89bd601da0afb62b31ef1f79a38d71 (diff)
downloadhaskell-532337cb8181f31bd4a5475b2dc9740d428657b5.tar.gz
Optimize some rts_mk/rts_get functions in RtsAPI.c
- All rts_mk functions return the tagged closure address - rts_mkChar/rts_mkInt avoid allocation when the argument is within the CHARLIKE/INTLIKE range - rts_getBool avoids a memory load by checking the closure tag - In rts_mkInt64/rts_mkWord64, allocated closure payload size is either 1 or 2 words depending on target architecture word size
Diffstat (limited to 'rts')
-rw-r--r--rts/RtsAPI.c69
1 files changed, 43 insertions, 26 deletions
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 841d0419ab..d9517529d2 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -30,19 +30,31 @@
HaskellObj
rts_mkChar (Capability *cap, HsChar c)
{
- StgClosure *p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1));
- SET_HDR(p, Czh_con_info, CCS_SYSTEM);
- p->payload[0] = (StgClosure *)(StgWord)(StgChar)c;
- return p;
+ StgClosure *p;
+ // See Note [Precomputed static closures]
+ if (c <= MAX_CHARLIKE) {
+ p = (StgClosure *)CHARLIKE_CLOSURE(c);
+ } else {
+ p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1));
+ SET_HDR(p, Czh_con_info, CCS_SYSTEM);
+ p->payload[0] = (StgClosure *)(StgWord)(StgChar)c;
+ }
+ return TAG_CLOSURE(1, p);
}
HaskellObj
rts_mkInt (Capability *cap, HsInt i)
{
- StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
- SET_HDR(p, Izh_con_info, CCS_SYSTEM);
- p->payload[0] = (StgClosure *)(StgInt)i;
- return p;
+ StgClosure *p;
+ // See Note [Precomputed static closures]
+ if (i >= MIN_INTLIKE && i <= MAX_INTLIKE) {
+ p = (StgClosure *)INTLIKE_CLOSURE(i);
+ } else {
+ p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
+ SET_HDR(p, Izh_con_info, CCS_SYSTEM);
+ p->payload[0] = (StgClosure *)(StgInt)i;
+ }
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -52,7 +64,7 @@ rts_mkInt8 (Capability *cap, HsInt8 i)
SET_HDR(p, I8zh_con_info, CCS_SYSTEM);
/* Make sure we mask out the bits above the lowest 8 */
p->payload[0] = (StgClosure *)(StgInt)i;
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -62,7 +74,7 @@ rts_mkInt16 (Capability *cap, HsInt16 i)
SET_HDR(p, I16zh_con_info, CCS_SYSTEM);
/* Make sure we mask out the relevant bits */
p->payload[0] = (StgClosure *)(StgInt)i;
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -71,16 +83,16 @@ rts_mkInt32 (Capability *cap, HsInt32 i)
StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, I32zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgInt)i;
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
rts_mkInt64 (Capability *cap, HsInt64 i)
{
- StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgInt64)));
SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
ASSIGN_Int64((P_)&(p->payload[0]), i);
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -89,7 +101,7 @@ rts_mkWord (Capability *cap, HsWord i)
StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, Wzh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)i;
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -99,7 +111,7 @@ rts_mkWord8 (Capability *cap, HsWord8 w)
StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, W8zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xff);
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -109,7 +121,7 @@ rts_mkWord16 (Capability *cap, HsWord16 w)
StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, W16zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff);
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -119,17 +131,17 @@ rts_mkWord32 (Capability *cap, HsWord32 w)
StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, W32zh_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff);
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
rts_mkWord64 (Capability *cap, HsWord64 w)
{
- StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
+ StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgWord64)));
/* see mk_Int8 comment */
SET_HDR(p, W64zh_con_info, CCS_SYSTEM);
ASSIGN_Word64((P_)&(p->payload[0]), w);
- return p;
+ return TAG_CLOSURE(1, p);
}
@@ -139,7 +151,7 @@ rts_mkFloat (Capability *cap, HsFloat f)
StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
SET_HDR(p, Fzh_con_info, CCS_SYSTEM);
ASSIGN_FLT((P_)p->payload, (StgFloat)f);
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -148,7 +160,7 @@ rts_mkDouble (Capability *cap, HsDouble d)
StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
SET_HDR(p, Dzh_con_info, CCS_SYSTEM);
ASSIGN_DBL((P_)p->payload, (StgDouble)d);
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -157,7 +169,7 @@ rts_mkStablePtr (Capability *cap, HsStablePtr s)
StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
SET_HDR(p, StablePtr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)s;
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -166,7 +178,7 @@ rts_mkPtr (Capability *cap, HsPtr a)
StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
SET_HDR(p, Ptr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)a;
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
@@ -175,16 +187,16 @@ rts_mkFunPtr (Capability *cap, HsFunPtr a)
StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
SET_HDR(p, FunPtr_con_info, CCS_SYSTEM);
p->payload[0] = (StgClosure *)a;
- return p;
+ return TAG_CLOSURE(1, p);
}
HaskellObj
rts_mkBool (Capability *cap STG_UNUSED, HsBool b)
{
if (b) {
- return (StgClosure *)True_closure;
+ return TAG_CLOSURE(2, (StgClosure *)True_closure);
} else {
- return (StgClosure *)False_closure;
+ return TAG_CLOSURE(1, (StgClosure *)False_closure);
}
}
@@ -365,6 +377,11 @@ rts_getFunPtr (HaskellObj p)
HsBool
rts_getBool (HaskellObj p)
{
+ const StgWord tag = GET_CLOSURE_TAG(p);
+ if (tag > 0) {
+ return tag - 1;
+ }
+
const StgInfoTable *info;
info = get_itbl((const StgClosure *)UNTAG_CONST_CLOSURE(p));