rts: Introduce and use ExecPage abstraction

Here we introduce a very thin abstraction for allocating, filling, and
freezing executable pages to replace allocateExec.

10 files changed, 96 insertions, 70 deletions

diff --git a/rts/ExecPage.c b/rts/ExecPage.c
new file mode 100644
index 0000000000..6f5b6e281a
--- /dev/null
+++ b/rts/ExecPage.c
@@ -0,0 +1,24 @@
+/*
+ * Utilities for managing dynamically-allocated executable pages.
+ *
+ * These are primarily used to back the adjustor code produced by the native
+ * adjustor implementations.
+ */
+
+#include "Rts.h"
+#include "LinkerInternals.h"
+#include "sm/OSMem.h"
+
+ExecPage *allocateExecPage() {
+    ExecPage *page = (ExecPage *) mmapAnonForLinker(getPageSize());
+    return page;
+}
+
+void freezeExecPage(ExecPage *page) {
+    mmapForLinkerMarkExecutable(page, getPageSize());
+    flushExec(getPageSize(), page);
+}
+
+void freeExecPage(ExecPage *page) {
+    munmapForLinker(page, getPageSize(), "freeExecPage");
+}
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 993af91528..170655a48c 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -977,9 +977,9 @@
       SymI_HasProto(large_alloc_lim)                                    \
       SymI_HasProto(g0)                                                 \
       SymI_HasProto(allocate)                                           \
-      SymI_HasProto(allocateExec)                                       \
-      SymI_HasProto(flushExec)                                          \
-      SymI_HasProto(freeExec)                                           \
+      SymI_HasProto(allocateExecPage)                                   \
+      SymI_HasProto(freezeExecPage)                                     \
+      SymI_HasProto(freeExecPage)                                       \
       SymI_HasProto(getAllocations)                                     \
       SymI_HasProto(revertCAFs)                                         \
       SymI_HasProto(RtsFlags)                                           \
diff --git a/rts/adjustor/NativeAlpha.c b/rts/adjustor/NativeAlpha.c
index e36a38d9dc..46fe4c090d 100644
--- a/rts/adjustor/NativeAlpha.c
+++ b/rts/adjustor/NativeAlpha.c
@@ -21,9 +21,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
                char *typeString STG_UNUSED
     )
 {
-    void *adjustor = NULL;
-    void *code = NULL;
-
     switch (cconv)
     {
     case 1: /* _ccall */
@@ -67,10 +64,10 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
       4 bytes), we should move the first three instructions above down by
       4 bytes (getting rid of the nop), hence saving memory. [ccshan]
   */
-    ASSERT(((StgWord64)wptr & 3) == 0);
-    adjustor = allocateExec(48,&code);
     {
-        StgWord64 *const code = (StgWord64 *)adjustor;
+        ASSERT(((StgWord64)wptr & 3) == 0);
+        ExecPage *page = allocateExecPage();
+        StgWord64 *const code = (StgWord64 *) page;
 
         code[0] = 0x4610041246520414L;
         code[1] = 0x46730415a61b0020L;
@@ -81,15 +78,15 @@ TODO: Depending on how much allocation overhead stgMallocBytes uses for
         code[4] = (StgWord64)hptr;
         code[5] = (StgWord64)wptr;
 
+        freezeExecPage(page);
         /* Ensure that instruction cache is consistent with our new code */
         __asm__ volatile("call_pal %0" : : "i" (PAL_imb));
+        return code;
     }
 
     default:
         barf("createAdjustor: Unsupported calling convention");
     }
-
-    return code;
 }
 
 void
@@ -103,5 +100,5 @@ freeHaskellFunctionPtr(void* ptr)
     /* Free the stable pointer first..*/
     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
 
-    freeExec(ptr);
+    freeExecPage((ExecPage *) ptr);
 }
diff --git a/rts/adjustor/NativeAmd64.c b/rts/adjustor/NativeAmd64.c
index f1a92eacc5..67efe7aa31 100644
--- a/rts/adjustor/NativeAmd64.c
+++ b/rts/adjustor/NativeAmd64.c
@@ -55,9 +55,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
                char *typeString
     )
 {
-    void *adjustor = NULL;
-    void *code = NULL;
-
     switch (cconv)
     {
     case 1: /* _ccall */
@@ -140,8 +137,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
 
     */
     {
-        StgWord8 *adj_code;
-
         // determine whether we have 4 or more integer arguments,
         // and therefore need to flush one to the stack.
         if ((typeString[0] == '\0') ||
@@ -149,8 +144,8 @@ createAdjustor(int cconv, StgStablePtr hptr,
             (typeString[2] == '\0') ||
             (typeString[3] == '\0')) {
 
-            adjustor = allocateExec(0x38,&code);
-            adj_code = (StgWord8*)adjustor;
+            ExecPage *page = allocateExecPage();
+            StgWord8 *adj_code = (StgWord8*) page;
 
             *(StgInt32 *)adj_code        = 0x49c1894d;
             *(StgInt32 *)(adj_code+0x4)  = 0x8948d089;
@@ -164,14 +159,16 @@ createAdjustor(int cconv, StgStablePtr hptr,
             *(StgInt32 *)(adj_code+0x20) = 0x00000000;
             *(StgInt64 *)(adj_code+0x28) = (StgInt64)hptr;
             *(StgInt64 *)(adj_code+0x30) = (StgInt64)wptr;
+
+            freezeExecPage(page);
+            return page;
         }
         else
         {
-            int fourthFloating;
+            bool fourthFloating = (typeString[3] == 'f' || typeString[3] == 'd');
+            ExecPage *page = allocateExecPage();
+            StgWord8 *adj_code = (StgWord8*) page;
 
-            fourthFloating = (typeString[3] == 'f' || typeString[3] == 'd');
-            adjustor = allocateExec(0x58,&code);
-            adj_code = (StgWord8*)adjustor;
             *(StgInt32 *)adj_code        = 0x08ec8348;
             *(StgInt32 *)(adj_code+0x4)  = fourthFloating ? 0x5c110ff2
                                                           : 0x4c894c90;
@@ -192,6 +189,9 @@ createAdjustor(int cconv, StgStablePtr hptr,
             *(StgInt64 *)(adj_code+0x40) = (StgInt64)obscure_ccall_ret_code;
             *(StgInt64 *)(adj_code+0x48) = (StgInt64)hptr;
             *(StgInt64 *)(adj_code+0x50) = (StgInt64)wptr;
+
+            freezeExecPage(page);
+            return page;
         }
     }
 
@@ -256,7 +256,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
     {
         int i = 0;
         char *c;
-        StgWord8 *adj_code;
 
         // determine whether we have 6 or more integer arguments,
         // and therefore need to flush one to the stack.
@@ -266,8 +265,8 @@ createAdjustor(int cconv, StgStablePtr hptr,
         }
 
         if (i < 6) {
-            adjustor = allocateExec(0x30,&code);
-            adj_code = (StgWord8*)adjustor;
+            ExecPage *page = allocateExecPage();
+            StgWord8 *adj_code = (StgWord8*) page;
 
             *(StgInt32 *)adj_code        = 0x49c1894d;
             *(StgInt32 *)(adj_code+0x4)  = 0x8948c889;
@@ -278,11 +277,14 @@ createAdjustor(int cconv, StgStablePtr hptr,
             *(StgInt32 *)(adj_code+0x18) = 0x0000000c;
             *(StgInt64 *)(adj_code+0x20) = (StgInt64)hptr;
             *(StgInt64 *)(adj_code+0x28) = (StgInt64)wptr;
+
+            freezeExecPage(page);
+            return page;
         }
         else
         {
-            adjustor = allocateExec(0x40,&code);
-            adj_code = (StgWord8*)adjustor;
+            ExecPage *page = allocateExecPage();
+            StgWord8 *adj_code = (StgWord8*) page;
 
             *(StgInt32 *)adj_code        = 0x35ff5141;
             *(StgInt32 *)(adj_code+0x4)  = 0x00000020;
@@ -297,6 +299,9 @@ createAdjustor(int cconv, StgStablePtr hptr,
             *(StgInt64 *)(adj_code+0x28) = (StgInt64)obscure_ccall_ret_code;
             *(StgInt64 *)(adj_code+0x30) = (StgInt64)hptr;
             *(StgInt64 *)(adj_code+0x38) = (StgInt64)wptr;
+
+            freezeExecPage(page);
+            return page;
         }
     }
 #endif /* defined(mingw32_HOST_OS) */
@@ -305,8 +310,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
         barf("createAdjustor: Unsupported calling convention");
         break;
     }
-
-    return code;
 }
 
 void freeHaskellFunctionPtr(void* ptr)
@@ -332,5 +335,5 @@ void freeHaskellFunctionPtr(void* ptr)
         return;
     }
 
-    freeExec(ptr);
+    freeExecPage((ExecPage *) ptr);
 }
diff --git a/rts/adjustor/NativePowerPC.c b/rts/adjustor/NativePowerPC.c
index 41da4588a5..2e5d60549a 100644
--- a/rts/adjustor/NativePowerPC.c
+++ b/rts/adjustor/NativePowerPC.c
@@ -59,9 +59,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
                char *typeString
     )
 {
-    void *adjustor = NULL;
-    void *code = NULL;
-
     switch (cconv)
     {
     case 1: /* _ccall */
@@ -81,7 +78,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
         int n = strlen(typeString),i;
         int src_locs[n], dst_locs[n];
         int frameSize;
-        unsigned *code;
 
             /* Step 1:
                Calculate where the arguments should go.
@@ -154,8 +150,8 @@ createAdjustor(int cconv, StgStablePtr hptr,
             */
                     // allocate space for at most 4 insns per parameter
                     // plus 14 more instructions.
-        adjustor = allocateExec(4 * (4*n + 14),&code);
-        code = (unsigned*)adjustor;
+        ExecPage *page = allocateExecPage();
+        unsigned *code = adjustor;
 
         *code++ = 0x48000008; // b *+8
             // * Put the hptr in a place where freeHaskellFunctionPtr
@@ -261,6 +257,8 @@ createAdjustor(int cconv, StgStablePtr hptr,
             // bctr
         *code++ = 0x4e800420;
 
+        freezeExecPage(page);
+
         // Flush the Instruction cache:
         {
             unsigned *p = adjustor;
@@ -304,7 +302,8 @@ createAdjustor(int cconv, StgStablePtr hptr,
 #if defined(FUNDESCS)
         adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor");
 #else
-        adjustorStub = allocateExec(sizeof(AdjustorStub),&code);
+        ExecPage *page = allocateExecPage();
+        adjustorStub = (AdjustorStub *) page;
 #endif /* defined(FUNDESCS) */
         adjustor = adjustorStub;
 
@@ -330,6 +329,8 @@ createAdjustor(int cconv, StgStablePtr hptr,
         adjustorStub->mtctr = 0x7c0903a6;
             // bctr
         adjustorStub->bctr = 0x4e800420;
+
+        freezeExecPage(page);
 #else
         barf("adjustor creation not supported on this platform");
 #endif /* defined(powerpc_HOST_ARCH) */
@@ -375,13 +376,13 @@ createAdjustor(int cconv, StgStablePtr hptr,
         adjustorStub->wptr = wptr;
         adjustorStub->negative_framesize = -total_sz;
         adjustorStub->extrawords_plus_one = extra_sz + 1;
+
+        return code;
     }
 
     default:
         barf("createAdjustor: Unsupported calling convention");
     }
-
-    return code;
 }
 
 void
@@ -401,5 +402,5 @@ freeHaskellFunctionPtr(void* ptr)
     freeStablePtr(((AdjustorStub*)ptr)->hptr);
 #endif
 
-    freeExec(ptr);
+    freeExecPage(ptr);
 }
diff --git a/rts/adjustor/NativeSparc.c b/rts/adjustor/NativeSparc.c
index 856f696813..059455d050 100644
--- a/rts/adjustor/NativeSparc.c
+++ b/rts/adjustor/NativeSparc.c
@@ -14,9 +14,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
                char *typeString STG_UNUSED
     )
 {
-    void *adjustor = NULL;
-    void *code = NULL;
-
     switch (cconv)
     {
     case 1: /* _ccall */
@@ -49,9 +46,9 @@ createAdjustor(int cconv, StgStablePtr hptr,
      similarly, and local variables should be accessed via %fp, not %sp. In a
      nutshell: This should work! (Famous last words! :-)
   */
-    adjustor = allocateExec(4*(11+1),&code);
     {
-        unsigned long *const adj_code = (unsigned long *)adjustor;
+        ExecPage *page = allocateExecPage();
+        unsigned long *const adj_code = (unsigned long *) page;
 
         adj_code[ 0]  = 0x9C23A008UL;   /* sub   %sp, 8, %sp         */
         adj_code[ 1]  = 0xDA23A060UL;   /* st    %o5, [%sp + 96]     */
@@ -71,6 +68,8 @@ createAdjustor(int cconv, StgStablePtr hptr,
 
         adj_code[11]  = (unsigned long)hptr;
 
+        freezeExecPage(page);
+
         /* flush cache */
         asm("flush %0" : : "r" (adj_code     ));
         asm("flush %0" : : "r" (adj_code +  2));
@@ -83,13 +82,13 @@ createAdjustor(int cconv, StgStablePtr hptr,
         asm("nop");
         asm("nop");
         asm("nop");
+
+        return page;
     }
 
     default:
         barf("createAdjustor: Unsupported calling convention");
     }
-
-    return code;
 }
 
 void
@@ -103,5 +102,5 @@ freeHaskellFunctionPtr(void* ptr)
     /* Free the stable pointer first..*/
     freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 11)));
 
-    freeExec(ptr);
+    freeExecPage(ptr);
 }
diff --git a/rts/adjustor/Nativei386.c b/rts/adjustor/Nativei386.c
index c0e7e0a4d3..af6d842be8 100644
--- a/rts/adjustor/Nativei386.c
+++ b/rts/adjustor/Nativei386.c
@@ -34,9 +34,6 @@ createAdjustor(int cconv, StgStablePtr hptr,
                char *typeString STG_UNUSED
     )
 {
-    void *adjustor = NULL;
-    void *code = NULL;
-
     switch (cconv)
     {
     case 0: /* _stdcall */
@@ -55,20 +52,23 @@ createAdjustor(int cconv, StgStablePtr hptr,
     */
 
     {
-        unsigned char adj_code[14];
-        adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
+        ExecPage *page = allocateExecPage();
+        uint8_t *adj_code = (uint8_t *) page;
+        adj_code[0x00] = 0x58;  /* popl %eax  */
 
-        adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
+        adj_code[0x01] = 0x68;  /* pushl hptr (which is a dword immediate ) */
         *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
 
-        adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
+        adj_code[0x06] = 0x50; /* pushl %eax */
 
-        adj_code[0x07] = (unsigned char)0xb8; /* movl  $wptr, %eax */
+        adj_code[0x07] = 0xb8; /* movl  $wptr, %eax */
         *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
 
-        adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
-        adj_code[0x0d] = (unsigned char)0xe0;
-        adjustor = allocateExec(14, &adj_code);
+        adj_code[0x0c] = 0xff; /* jmp %eax */
+        adj_code[0x0d] = 0xe0;
+
+        freezeExecPage(page);
+        return page;
     }
 #endif /* !defined(darwin_HOST_OS) */
 
@@ -82,13 +82,12 @@ createAdjustor(int cconv, StgStablePtr hptr,
 
           We offload most of the work to AdjustorAsm.S.
         */
-        AdjustorStub *adjustorStub = allocateExec(sizeof(AdjustorStub),&code);
-        adjustor = adjustorStub;
-
+        ExecPage *page = allocateExecPage();
+        AdjustorStub *adjustorStub = (AdjustorStub *) page;
         int sz = totalArgumentSize(typeString);
 
         adjustorStub->call[0] = 0xe8;
-        *(long*)&adjustorStub->call[1] = ((char*)&adjustorCode) - ((char*)code + 5);
+        *(long*)&adjustorStub->call[1] = ((char*)&adjustorCode) - ((char*)page + 5);
         adjustorStub->hptr = hptr;
         adjustorStub->wptr = wptr;
 
@@ -107,13 +106,14 @@ createAdjustor(int cconv, StgStablePtr hptr,
             // only count 2.) and 3.) as part of frame_size
         adjustorStub->frame_size -= 12;
         adjustorStub->argument_size = sz;
+
+        freezeExecPage(page);
+        return page;
     }
 
     default:
         barf("createAdjustor: Unsupported calling convention");
     }
-
-    return code;
 }
 
 void
@@ -130,5 +130,5 @@ freeHaskellFunctionPtr(void* ptr)
         freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
     }
 
-    freeExec(ptr);
+    freeExecPage((ExecPage *) ptr);
 }
diff --git a/rts/ghc.mk b/rts/ghc.mk
index d3e533d1f7..24a4240c59 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -17,7 +17,7 @@
 rts_dist_HC = $(GHC_STAGE1)
 
 rts_INSTALL_INFO = rts
-rts_VERSION = 1.0.1
+rts_VERSION = 1.0.2
 
 # Minimum supported Windows version.
 # These numbers can be found at:
diff --git a/rts/package.conf.in b/rts/package.conf.in
index f703feec06..9bc48d57ca 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -5,7 +5,7 @@
 #include "MachDeps.h"
 
 name:           rts
-version:        1.0.1
+version:        1.0.2
 id:             rts
 key:            rts
 license:        BSD-3-Clause
diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in
index 7c0f40dcfa..ded2f15509 100644
--- a/rts/rts.cabal.in
+++ b/rts/rts.cabal.in
@@ -1,6 +1,6 @@
 cabal-version: 3.0
 name: rts
-version: 1.0.1
+version: 1.0.2
 license: BSD-3-Clause
 maintainer: glasgow-haskell-users@haskell.org
 build-type: Simple
@@ -145,6 +145,7 @@ library
                       DerivedConstants.h ffi.h ffitarget.h
                       -- ^ generated
                       rts/Adjustor.h
+                      rts/ExecPage.h
                       rts/BlockSignals.h
                       rts/Bytecodes.h
                       rts/Config.h
@@ -442,6 +443,7 @@ library
       asm-sources: StgCRunAsm.S
 
     c-sources: Adjustor.c
+               ExecPage.c
                Arena.c
                Capability.c
                CheckUnload.c