[Git][ghc/ghc][master] 5 commits: rts: Tighten up invariants of PACK

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Nov 15 00:07:53 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
aa58fc5b by Ben Gamari at 2024-11-14T19:06:49-05:00
rts: Tighten up invariants of PACK

- - - - -
8aa4c10a by Ben Gamari at 2024-11-14T19:06:49-05:00
testsuite: Fix badly escaped literals

Use raw string literals to ensure that `\s` is correctly interpreted as
a character class.

- - - - -
0e084029 by Ben Gamari at 2024-11-14T19:06:49-05:00
rts: Improve documentation of SLIDE bytecode instruction

- - - - -
9bf3663b by Ben Gamari at 2024-11-14T19:06:49-05:00
rts/Interpreter: Assert that TEST*_P discriminators are valid

- - - - -
1f668511 by Ben Gamari at 2024-11-14T19:06:49-05:00
rts/Interpreter: Improve documentation of TEST*_P instructions

- - - - -


4 changed files:

- compiler/GHC/ByteCode/Instr.hs
- rts/Interpreter.c
- rts/include/rts/storage/InfoTables.h
- testsuite/driver/testlib.py


Changes:

=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -130,7 +130,18 @@ data BCInstr
    | PUSH_APPLY_PPPPP
    | PUSH_APPLY_PPPPPP
 
-   | SLIDE     !WordOff{-this many-} !WordOff{-down by this much-}
+   -- | Drop entries @(n, n+by]@ entries from the stack. Graphically:
+   -- @
+   -- a_1  ← top
+   -- ...
+   -- a_n
+   -- b_1              =>    a_1  ← top
+   -- ...                    ...
+   -- b_by                   a_n
+   -- k                      k
+   -- @
+   | SLIDE     !WordOff -- ^ n = this many
+               !WordOff -- ^ by = down by this much
 
    -- To do with the heap
    | ALLOC_AP  !HalfWord {- make an AP with this many payload words.
@@ -175,7 +186,12 @@ data BCInstr
    -- The Word16 value is a constructor number and therefore
    -- stored in the insn stream rather than as an offset into
    -- the literal pool.
+
+   -- | Test whether the tag of a closure pointer is less than the given value.
+   -- If not, jump to the given label.
    | TESTLT_P  !Word16 LocalLabel
+   -- | Test whether the tag of a closure pointer is equal to the given value.
+   -- If not, jump to the given label.
    | TESTEQ_P  !Word16 LocalLabel
 
    | CASEFAIL


=====================================
rts/Interpreter.c
=====================================
@@ -1630,7 +1630,11 @@ run_BCO:
         case bci_SLIDE: {
             W_ n  = BCO_GET_LARGE_ARG;
             W_ by = BCO_GET_LARGE_ARG;
-            /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
+            /*
+             * a_1 ... a_n, b_1 ... b_by, k
+             *           =>
+             * a_1 ... a_n, k
+             */
             while(n-- > 0) {
                 SpW(n+by) = SpW(n);
             }
@@ -1744,23 +1748,29 @@ run_BCO:
         }
 
         case bci_PACK: {
-            W_ i;
             W_ o_itbl         = BCO_GET_LARGE_ARG;
             W_ n_words        = BCO_GET_LARGE_ARG;
-            StgInfoTable* itbl = INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl));
-            int request        = CONSTR_sizeW( itbl->layout.payload.ptrs,
-                                               itbl->layout.payload.nptrs );
+            StgConInfoTable* itbl = CON_INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl));
+            W_ n_ptrs         = itbl->i.layout.payload.ptrs;
+            W_ n_nptrs        = itbl->i.layout.payload.nptrs;
+            W_ request        = CONSTR_sizeW( n_ptrs, n_nptrs );
             StgClosure* con = (StgClosure*)allocate_NONUPD(cap,request);
-            ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0);
-            for (i = 0; i < n_words; i++) {
+            ASSERT(ip_HNF(&itbl->i)); // We don't have a CON flag, HNF is a good approximation
+                                      // N.
+            // N.B. we may have a nullary datacon with padding, in which case
+            // n_nptrs=1, n_ptrs=0.
+            ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0));
+            ASSERT(n_ptrs + n_nptrs > 0);
+            //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors
+            for (W_ i = 0; i < n_words; i++) {
                 con->payload[i] = (StgClosure*)SpW(i);
             }
             Sp_addW(n_words);
             Sp_subW(1);
             // No write barrier is needed here as this is a new allocation
             // visible only from our stack
-            StgInfoTable *con_itbl = (StgInfoTable*) BCO_LIT(o_itbl);
-            SET_HDR(con, con_itbl, cap->r.rCCCS);
+            StgInfoTable *con_ptr = (StgInfoTable*) BCO_LIT(o_itbl);
+            SET_HDR(con, con_ptr, cap->r.rCCCS);
 
             StgClosure* tagged_con = tagConstr(con);
             SpW(0) = (W_)tagged_con;
@@ -1775,6 +1785,7 @@ run_BCO:
         case bci_TESTLT_P: {
             unsigned int discr  = BCO_NEXT;
             int failto = BCO_GET_LARGE_ARG;
+            ASSERT(discr <= TAG_MASK);
             StgClosure* con = UNTAG_CLOSURE((StgClosure*)SpW(0));
             if (GET_TAG(con) >= discr) {
                 bciPtr = failto;
@@ -1785,6 +1796,7 @@ run_BCO:
         case bci_TESTEQ_P: {
             unsigned int discr  = BCO_NEXT;
             int failto = BCO_GET_LARGE_ARG;
+            ASSERT(discr <= TAG_MASK);
             StgClosure* con = UNTAG_CLOSURE((StgClosure*)SpW(0));
             if (GET_TAG(con) != discr) {
                 bciPtr = failto;


=====================================
rts/include/rts/storage/InfoTables.h
=====================================
@@ -86,7 +86,7 @@ extern const StgWord16 closure_flags[];
 #define closure_IND(c)          (  closureFlags(c) & _IND)
 
 /* same as above but for info-ptr rather than closure */
-#define ipFlags(ip)             (closure_flags[ip->type])
+#define ipFlags(ip)             (closure_flags[(ip)->type])
 
 #define ip_HNF(ip)               (  ipFlags(ip) & _HNF)
 #define ip_BITMAP(ip)            (  ipFlags(ip) & _BTM)


=====================================
testsuite/driver/testlib.py
=====================================
@@ -3000,12 +3000,12 @@ def normalise_prof (s: str) -> str:
     # Source locations from internal libraries, remove the source location
     # > libraries/ghc-internal/src/path/Foo.hs:204:1-18
     # => ghc-internal/src/path/Foo.hs
-    s = re.sub('\slibraries/(\S+)(:\S+){2}\s',' \\1 ', s)
+    s = re.sub(r'\slibraries/(\S+)(:\S+){2}\s', r' \1 ', s)
 
     # Source locations from internal libraries, remove the source location
     # > libraries/ghc-internal/src/path/Foo.hs::(2,1)-(5,38)
     # => ghc-internal/src/path/Foo.hs
-    s = re.sub('\slibraries/(\S+)(:\S+){1}\s',' \\1 ', s)
+    s = re.sub(r'\slibraries/(\S+)(:\S+){1}\s', r' \1 ', s)
 
     # We have something like this:
     #



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1fd83f865ffb620f4f7c4c59787710206dcadb90...1f668511ff18cba9439c6ad1c77467f61f8e3b82

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1fd83f865ffb620f4f7c4c59787710206dcadb90...1f668511ff18cba9439c6ad1c77467f61f8e3b82
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/20241114/84180c34/attachment-0001.html>


More information about the ghc-commits mailing list