Remove the itbls field of BCO, put itbls in with the literals
authorSimon Marlow <simonmar@microsoft.com>
Tue, 27 Feb 2007 13:46:09 +0000 (13:46 +0000)
committerSimon Marlow <simonmar@microsoft.com>
Tue, 27 Feb 2007 13:46:09 +0000 (13:46 +0000)
This is a simplification & minor optimisation for GHCi

compiler/ghci/ByteCodeAsm.lhs
compiler/ghci/ByteCodeLink.lhs
compiler/prelude/primops.txt.pp
includes/Closures.h
includes/mkDerivedConstants.c
rts/Disassembler.c
rts/Interpreter.c
rts/PrimOps.cmm
rts/Sanity.c
rts/sm/Compact.c
rts/sm/Scav.c

index 1491f55..28263f9 100644 (file)
@@ -11,7 +11,7 @@ module ByteCodeAsm (
        assembleBCOs, assembleBCO,
 
        CompiledByteCode(..), 
-       UnlinkedBCO(..), BCOPtr(..), bcoFreeNames,
+       UnlinkedBCO(..), BCOPtr(..), BCONPtr(..), bcoFreeNames,
        SizedSeq, sizeSS, ssElts,
        iNTERP_STACK_CHECK_THRESH
   ) where
@@ -68,14 +68,10 @@ data UnlinkedBCO
    = UnlinkedBCO {
        unlinkedBCOName   :: Name,
        unlinkedBCOArity  :: Int,
-       unlinkedBCOInstrs :: ByteArray#,                         -- insns
-       unlinkedBCOBitmap :: ByteArray#,                         -- bitmap
-        unlinkedBCOLits   :: (SizedSeq (Either Word FastString)), -- literals
-                       -- Either literal words or a pointer to a asciiz
-                       -- string, denoting a label whose *address* should
-                       -- be determined at link time
-        unlinkedBCOPtrs   :: (SizedSeq BCOPtr),        -- ptrs
-       unlinkedBCOItbls  :: (SizedSeq Name)            -- itbl refs
+       unlinkedBCOInstrs :: ByteArray#,                 -- insns
+       unlinkedBCOBitmap :: ByteArray#,                 -- bitmap
+        unlinkedBCOLits   :: (SizedSeq BCONPtr),        -- non-ptrs
+        unlinkedBCOPtrs   :: (SizedSeq BCOPtr)                 -- ptrs
    }
 
 data BCOPtr
@@ -83,25 +79,29 @@ data BCOPtr
   | BCOPtrPrimOp PrimOp
   | BCOPtrBCO    UnlinkedBCO
 
+data BCONPtr
+  = BCONPtrWord  Word
+  | BCONPtrLbl   FastString
+  | BCONPtrItbl  Name
+
 -- | Finds external references.  Remember to remove the names
 -- defined by this group of BCOs themselves
 bcoFreeNames :: UnlinkedBCO -> NameSet
 bcoFreeNames bco
   = bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco]
   where
-    bco_refs (UnlinkedBCO _ _ _ _ _ ptrs itbls)
+    bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
        = unionManyNameSets (
             mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] :
-            mkNameSet (ssElts itbls) :
+            mkNameSet [ n | BCONPtrItbl n <- ssElts nonptrs ] :
             map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
          )
 
 instance Outputable UnlinkedBCO where
-   ppr (UnlinkedBCO nm arity insns bitmap lits ptrs itbls)
+   ppr (UnlinkedBCO nm arity insns bitmap lits ptrs)
       = sep [text "BCO", ppr nm, text "with", 
              int (sizeSS lits), text "lits",
-             int (sizeSS ptrs), text "ptrs",
-             int (sizeSS itbls), text "itbls"]
+             int (sizeSS ptrs), text "ptrs" ]
 
 -- -----------------------------------------------------------------------------
 -- The bytecode assembler
@@ -141,11 +141,10 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
      in
      do  -- pass 2: generate the instruction, ptr and nonptr bits
          insns <- return emptySS :: IO (SizedSeq Word16)
-         lits  <- return emptySS :: IO (SizedSeq (Either Word FastString))
+         lits  <- return emptySS :: IO (SizedSeq BCONPtr)
          ptrs  <- return emptySS :: IO (SizedSeq BCOPtr)
-         itbls <- return emptySS :: IO (SizedSeq Name)
-         let init_asm_state = (insns,lits,ptrs,itbls)
-         (final_insns, final_lits, final_ptrs, final_itbls) 
+         let init_asm_state = (insns,lits,ptrs)
+         (final_insns, final_lits, final_ptrs) 
             <- mkBits findLabel init_asm_state instrs
 
         let asm_insns = ssElts final_insns
@@ -160,7 +159,7 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
              bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
 
          let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits 
-                                       final_ptrs final_itbls
+                                       final_ptrs
 
          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
          -- objects, since they might get run too early.  Disable this until
@@ -180,11 +179,10 @@ mkInstrArray :: Int -> [Word16]   -> UArray Int Word16
 mkInstrArray n_insns asm_insns
   = listArray (0, n_insns) (fromIntegral n_insns : asm_insns)
 
--- instrs nonptrs ptrs itbls
+-- instrs nonptrs ptrs
 type AsmState = (SizedSeq Word16, 
-                 SizedSeq (Either Word FastString),
-                 SizedSeq BCOPtr, 
-                 SizedSeq Name)
+                 SizedSeq BCONPtr,
+                 SizedSeq BCOPtr)
 
 data SizedSeq a = SizedSeq !Int [a]
 emptySS = SizedSeq 0 []
@@ -307,68 +305,68 @@ mkBits findLabel st proto_insns
 
        instrn :: AsmState -> [Int] -> IO AsmState
        instrn st [] = return st
-       instrn (st_i, st_l, st_p, st_I) (i:is)
+       instrn (st_i, st_l, st_p) (i:is)
           = do st_i' <- addToSS st_i (i2s i)
-               instrn (st_i', st_l, st_p, st_I) is
+               instrn (st_i', st_l, st_p) is
 
-       instr1 (st_i0,st_l0,st_p0,st_I0) i1
+       instr1 (st_i0,st_l0,st_p0) i1
           = do st_i1 <- addToSS st_i0 i1
-               return (st_i1,st_l0,st_p0,st_I0)
+               return (st_i1,st_l0,st_p0)
 
-       instr2 (st_i0,st_l0,st_p0,st_I0) i1 i2
+       instr2 (st_i0,st_l0,st_p0) i1 i2
           = do st_i1 <- addToSS st_i0 (i2s i1)
                st_i2 <- addToSS st_i1 (i2s i2)
-               return (st_i2,st_l0,st_p0,st_I0)
+               return (st_i2,st_l0,st_p0)
 
-       instr3 (st_i0,st_l0,st_p0,st_I0) i1 i2 i3
+       instr3 (st_i0,st_l0,st_p0) i1 i2 i3
           = do st_i1 <- addToSS st_i0 (i2s i1)
                st_i2 <- addToSS st_i1 (i2s i2)
                st_i3 <- addToSS st_i2 (i2s i3)
-               return (st_i3,st_l0,st_p0,st_I0)
+               return (st_i3,st_l0,st_p0)
 
-       instr4 (st_i0,st_l0,st_p0,st_I0) i1 i2 i3 i4
+       instr4 (st_i0,st_l0,st_p0) i1 i2 i3 i4
           = do st_i1 <- addToSS st_i0 (i2s i1)
                st_i2 <- addToSS st_i1 (i2s i2)
                st_i3 <- addToSS st_i2 (i2s i3)
                st_i4 <- addToSS st_i3 (i2s i4)
-               return (st_i4,st_l0,st_p0,st_I0)
+               return (st_i4,st_l0,st_p0)
 
-       float (st_i0,st_l0,st_p0,st_I0) f
+       float (st_i0,st_l0,st_p0) f
           = do let ws = mkLitF f
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
+               st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
+               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 
-       double (st_i0,st_l0,st_p0,st_I0) d
+       double (st_i0,st_l0,st_p0) d
           = do let ws = mkLitD d
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
+               st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
+               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 
-       int (st_i0,st_l0,st_p0,st_I0) i
+       int (st_i0,st_l0,st_p0) i
           = do let ws = mkLitI i
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
+               st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
+               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 
-       int64 (st_i0,st_l0,st_p0,st_I0) i
+       int64 (st_i0,st_l0,st_p0) i
           = do let ws = mkLitI64 i
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
+               st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
+               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 
-       addr (st_i0,st_l0,st_p0,st_I0) a
+       addr (st_i0,st_l0,st_p0) a
           = do let ws = mkLitPtr a
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
+               st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
+               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 
-       litlabel (st_i0,st_l0,st_p0,st_I0) fs
-          = do st_l1 <- addListToSS st_l0 [Right fs]
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
+       litlabel (st_i0,st_l0,st_p0) fs
+          = do st_l1 <- addListToSS st_l0 [BCONPtrLbl fs]
+               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 
-       ptr (st_i0,st_l0,st_p0,st_I0) p
+       ptr (st_i0,st_l0,st_p0) p
           = do st_p1 <- addToSS st_p0 p
-               return (sizeSS st_p0, (st_i0,st_l0,st_p1,st_I0))
+               return (sizeSS st_p0, (st_i0,st_l0,st_p1))
 
-       itbl (st_i0,st_l0,st_p0,st_I0) dcon
-          = do st_I1 <- addToSS st_I0 (getName dcon)
-               return (sizeSS st_I0, (st_i0,st_l0,st_p0,st_I1))
+       itbl (st_i0,st_l0,st_p0) dcon
+          = do st_l1 <- addToSS st_l0 (BCONPtrItbl (getName dcon))
+               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 
 #ifdef mingw32_TARGET_OS
        literal st (MachLabel fs (Just sz)) 
index c58ae87..9988325 100644 (file)
@@ -43,9 +43,7 @@ import Control.Exception ( throwDyn )
 import Control.Monad   ( zipWithM )
 import Control.Monad.ST ( stToIO )
 
-import GHC.Exts                ( BCO#, newBCO#, unsafeCoerce#, Int#,
-                         ByteArray#, Array#, addrToHValue#, mkApUpd0# )
-
+import GHC.Exts
 import GHC.Arr         ( Array(..) )
 import GHC.IOBase      ( IO(..) )
 import GHC.Ptr         ( Ptr(..), castPtr )
@@ -107,35 +105,28 @@ linkBCO ie ce ul_bco
 
 
 linkBCO' :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO BCO
-linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS itblsSS)
+linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS)
    -- Raises an IO exception on failure
    = do let literals = ssElts literalsSS
            ptrs     = ssElts ptrsSS
-           itbls    = ssElts itblsSS
 
-        linked_itbls    <- mapM (lookupIE ie) itbls
-        linked_literals <- mapM lookupLiteral literals
+        linked_literals <- mapM (lookupLiteral ie) literals
 
         let n_literals = sizeSS literalsSS
             n_ptrs     = sizeSS ptrsSS
-            n_itbls    = sizeSS itblsSS
 
        ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
 
         let 
             ptrs_parr = case ptrs_arr of Array lo hi parr -> parr
 
-            itbls_arr = listArray (0, n_itbls-1) linked_itbls
-
-            itbls_barr = case itbls_arr of UArray lo hi barr -> barr
-
             literals_arr = listArray (0, n_literals-1) linked_literals
                            :: UArray Int Word
             literals_barr = case literals_arr of UArray lo hi barr -> barr
 
            (I# arity#)  = arity
 
-        newBCO insns_barr literals_barr ptrs_parr itbls_barr arity# bitmap
+        newBCO insns_barr literals_barr ptrs_parr arity# bitmap
 
 
 -- we recursively link any sub-BCOs while making the ptrs array
@@ -175,20 +166,18 @@ writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
 data BCO = BCO BCO#
 
 newBCO :: ByteArray# -> ByteArray# -> Array# a
-        -> ByteArray# -> Int# -> ByteArray# -> IO BCO
-newBCO instrs lits ptrs itbls arity bitmap
-   = IO $ \s -> case newBCO# instrs lits ptrs itbls arity bitmap s of 
+        -> Int# -> ByteArray# -> IO BCO
+newBCO instrs lits ptrs arity bitmap
+   = IO $ \s -> case newBCO# instrs lits ptrs arity bitmap s of 
                  (# s1, bco #) -> (# s1, BCO bco #)
 
 
-lookupLiteral :: Either Word FastString -> IO Word
-lookupLiteral (Left lit)  = return lit
-lookupLiteral (Right sym) = do Ptr addr <- lookupStaticPtr sym
-                              return (W# (unsafeCoerce# addr)) 
-     -- Can't be bothered to find the official way to convert Addr# to Word#;
-     -- the FFI/Foreign designers make it too damn difficult
-     -- Hence we apply the Blunt Instrument, which works correctly
-     -- on all reasonable architectures anyway
+lookupLiteral :: ItblEnv -> BCONPtr -> IO Word
+lookupLiteral ie (BCONPtrWord lit) = return lit
+lookupLiteral ie (BCONPtrLbl  sym) = do Ptr a# <- lookupStaticPtr sym
+                                       return (W# (int2Word# (addr2Int# a#)))
+lookupLiteral ie (BCONPtrItbl nm)  = do Ptr a# <- lookupIE ie nm
+                                       return (W# (int2Word# (addr2Int# a#)))
 
 lookupStaticPtr :: FastString -> IO (Ptr ())
 lookupStaticPtr addr_of_label_string 
index f5a98c3..3493d05 100644 (file)
@@ -1672,7 +1672,7 @@ primop   MkApUpd0_Op "mkApUpd0#" GenPrimOp
    out_of_line = True
 
 primop  NewBCOOp "newBCO#" GenPrimOp
-   ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> Int# -> ByteArr# -> State# s -> (# State# s, BCO# #)
+   ByteArr# -> ByteArr# -> Array# a -> Int# -> ByteArr# -> State# s -> (# State# s, BCO# #)
    with
    has_side_effects = True
    out_of_line      = True
index d5458f4..64582ba 100644 (file)
@@ -232,7 +232,6 @@ typedef struct {
     StgArrWords   *instrs;     /* a pointer to an ArrWords */
     StgArrWords   *literals;   /* a pointer to an ArrWords */
     StgMutArrPtrs *ptrs;       /* a pointer to a  MutArrPtrs */
-    StgArrWords   *itbls;      /* a pointer to an ArrWords */
     StgHalfWord   arity;        /* arity of this BCO */
     StgHalfWord   size;         /* size of this BCO (in words) */
     StgWord       bitmap[FLEXIBLE_ARRAY];  /* an StgLargeBitmap */
index 8e3ac2b..c797941 100644 (file)
@@ -369,7 +369,6 @@ main(int argc, char *argv[])
     closure_field(StgBCO, instrs);
     closure_field(StgBCO, literals);
     closure_field(StgBCO, ptrs);
-    closure_field(StgBCO, itbls);
     closure_field(StgBCO, arity);
     closure_field(StgBCO, size);
     closure_payload(StgBCO, bitmap);
index f29cce2..4407c77 100644 (file)
@@ -41,9 +41,6 @@ disInstr ( StgBCO *bco, int pc )
    StgMutArrPtrs* ptrs_arr    = bco->ptrs;
    StgPtr*        ptrs        = (StgPtr*)(&ptrs_arr->payload[0]);
 
-   StgArrWords*   itbls_arr   = bco->itbls;
-   StgInfoTable** itbls       = (StgInfoTable**)(&itbls_arr->payload[0]);
-
    instr = instrs[pc++];
    switch (instr) {
       case bci_SWIZZLE:
@@ -163,7 +160,7 @@ disInstr ( StgBCO *bco, int pc )
          pc += 1; break;
       case bci_PACK:
          debugBelch("PACK      %d words with itbl ", instrs[pc+1] );
-         printPtr( (StgPtr)itbls[instrs[pc]] );
+         printPtr( (StgPtr)literals[instrs[pc]] );
          debugBelch("\n");
          pc += 2; break;
 
index 0312d3d..62fd2c2 100644 (file)
@@ -54,7 +54,6 @@
 
 #define BCO_PTR(n)    (W_)ptrs[n]
 #define BCO_LIT(n)    literals[n]
-#define BCO_ITBL(n)   itbls[n]
 
 #define LOAD_STACK_POINTERS                                    \
     Sp = cap->r.rCurrentTSO->sp;                               \
@@ -729,8 +728,6 @@ run_BCO:
        register StgWord16* instrs    = (StgWord16*)(bco->instrs->payload);
        register StgWord*  literals   = (StgWord*)(&bco->literals->payload[0]);
        register StgPtr*   ptrs       = (StgPtr*)(&bco->ptrs->payload[0]);
-       register StgInfoTable** itbls = (StgInfoTable**)
-           (&bco->itbls->payload[0]);
 
 #ifdef INTERP_STATS
        it_lastopc = 0; /* no opcode */
@@ -1018,12 +1015,12 @@ run_BCO:
            int i;
            int o_itbl         = BCO_NEXT;
            int n_words        = BCO_NEXT;
-           StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_ITBL(o_itbl));
+           StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_LIT(o_itbl));
            int request        = CONSTR_sizeW( itbl->layout.payload.ptrs, 
                                               itbl->layout.payload.nptrs );
            StgClosure* con = (StgClosure*)allocate_NONUPD(request);
            ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0);
-           SET_HDR(con, BCO_ITBL(o_itbl), CCS_SYSTEM/*ToDo*/);
+           SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), CCS_SYSTEM/*ToDo*/);
            for (i = 0; i < n_words; i++) {
                con->payload[i] = (StgClosure*)Sp[i];
            }
index e0823e4..955e50b 100644 (file)
@@ -1900,17 +1900,16 @@ newBCOzh_fast
     /* R1 = instrs
        R2 = literals
        R3 = ptrs
-       R4 = itbls
-       R5 = arity
-       R6 = bitmap array
+       R4 = arity
+       R5 = bitmap array
     */
     W_ bco, bitmap_arr, bytes, words;
     
-    bitmap_arr = R6;
+    bitmap_arr = R5;
     words = BYTES_TO_WDS(SIZEOF_StgBCO) + StgArrWords_words(bitmap_arr);
     bytes = WDS(words);
 
-    ALLOC_PRIM( bytes, R1_PTR&R2_PTR&R3_PTR&R4_PTR&R6_PTR, newBCOzh_fast );
+    ALLOC_PRIM( bytes, R1_PTR&R2_PTR&R3_PTR&R5_PTR, newBCOzh_fast );
 
     bco = Hp - bytes + WDS(1);
     SET_HDR(bco, stg_BCO_info, W_[CCCS]);
@@ -1918,8 +1917,7 @@ newBCOzh_fast
     StgBCO_instrs(bco)     = R1;
     StgBCO_literals(bco)   = R2;
     StgBCO_ptrs(bco)       = R3;
-    StgBCO_itbls(bco)      = R4;
-    StgBCO_arity(bco)      = HALF_W_(R5);
+    StgBCO_arity(bco)      = HALF_W_(R4);
     StgBCO_size(bco)       = HALF_W_(words);
     
     // Copy the arity/bitmap info into the BCO
index 48d913c..6fdca36 100644 (file)
@@ -324,7 +324,6 @@ checkClosure( StgClosure* p )
        ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->instrs));
        ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->literals));
        ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->ptrs));
-       ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->itbls));
        return bco_sizeW(bco);
     }
 
index 5cef816..62d9152 100644 (file)
@@ -530,7 +530,6 @@ thread_obj (StgInfoTable *info, StgPtr p)
        thread_(&bco->instrs);
        thread_(&bco->literals);
        thread_(&bco->ptrs);
-       thread_(&bco->itbls);
        return p + bco_sizeW(bco);
     }
 
index cd200f3..139ecad 100644 (file)
@@ -411,7 +411,6 @@ scavenge(step *stp)
        bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
        bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
        bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-       bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
        p += bco_sizeW(bco);
        break;
     }
@@ -792,7 +791,6 @@ linear_scan:
            bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
            bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
            bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-           bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
            break;
        }