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

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