Implemented word-sized addressing of pointers and literals.

3 files changed, 51 insertions, 56 deletions

diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 3119447880..91bcd430f0 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -216,8 +216,8 @@ data Operand
   | LabelOp Word16
 
 data Assembler a
-  = AllocPtr (IO BCOPtr) (Word16 -> Assembler a)
-  | AllocLit [BCONPtr] (Word16 -> Assembler a)
+  = AllocPtr (IO BCOPtr) (Word -> Assembler a)
+  | AllocLit [BCONPtr] (Word -> Assembler a)
   | AllocLabel Word16 (Assembler a)
   | Emit Word16 [Operand] (Assembler a)
   | NullAsm a
@@ -230,13 +230,13 @@ instance Monad Assembler where
   AllocLabel lbl k >>= f = AllocLabel lbl (k >>= f)
   Emit w ops k >>= f = Emit w ops (k >>= f)
 
-ioptr :: IO BCOPtr -> Assembler Word16
+ioptr :: IO BCOPtr -> Assembler Word
 ioptr p = AllocPtr p return
 
-ptr :: BCOPtr -> Assembler Word16
+ptr :: BCOPtr -> Assembler Word
 ptr = ioptr . return
 
-lit :: [BCONPtr] -> Assembler Word16
+lit :: [BCONPtr] -> Assembler Word
 lit l = AllocLit l return
 
 label :: Word16 -> Assembler ()
@@ -253,12 +253,12 @@ runAsm e (AllocPtr p_io k) = do
   p <- lift p_io
   w <- State $ \(st_i0,st_l0,st_p0) -> do
     let st_p1 = addToSS st_p0 p
-    return ((st_i0,st_l0,st_p1), sizeSS16 st_p0)
+    return ((st_i0,st_l0,st_p1), sizeSS st_p0)
   runAsm e $ k w
 runAsm e (AllocLit lits k) = do
   w <- State $ \(st_i0,st_l0,st_p0) -> do
     let st_l1 = addListToSS st_l0 lits
-    return ((st_i0,st_l1,st_p0), sizeSS16 st_l0)
+    return ((st_i0,st_l1,st_p0), sizeSS st_l0)
   runAsm e $ k w
 runAsm e (AllocLabel _ k) = runAsm e k
 runAsm e (Emit w ops k) = do
@@ -350,23 +350,23 @@ assembleI dflags i = case i of
   PUSH_LL o1 o2            -> emit bci_PUSH_LL [SmallOp o1, SmallOp o2]
   PUSH_LLL o1 o2 o3        -> emit bci_PUSH_LLL [SmallOp o1, SmallOp o2, SmallOp o3]
   PUSH_G nm                -> do p <- ptr (BCOPtrName nm)
-                                 emit bci_PUSH_G [SmallOp p]
+                                 emit bci_PUSH_G [Op p]
   PUSH_PRIMOP op           -> do p <- ptr (BCOPtrPrimOp op)
-                                 emit bci_PUSH_G [SmallOp p]
+                                 emit bci_PUSH_G [Op p]
   PUSH_BCO proto           -> do let ul_bco = assembleBCO dflags proto
                                  p <- ioptr (liftM BCOPtrBCO ul_bco)
-                                 emit bci_PUSH_G [SmallOp p]
+                                 emit bci_PUSH_G [Op p]
   PUSH_ALTS proto          -> do let ul_bco = assembleBCO dflags proto
                                  p <- ioptr (liftM BCOPtrBCO ul_bco)
-                                 emit bci_PUSH_ALTS [SmallOp p]
+                                 emit bci_PUSH_ALTS [Op p]
   PUSH_ALTS_UNLIFTED proto pk
                            -> do let ul_bco = assembleBCO dflags proto
                                  p <- ioptr (liftM BCOPtrBCO ul_bco)
-                                 emit (push_alts pk) [SmallOp p]
+                                 emit (push_alts pk) [Op p]
   PUSH_UBX (Left lit) nws  -> do np <- literal lit
-                                 emit bci_PUSH_UBX [SmallOp np, SmallOp nws]
+                                 emit bci_PUSH_UBX [Op np, SmallOp nws]
   PUSH_UBX (Right aa) nws  -> do np <- addr aa
-                                 emit bci_PUSH_UBX [SmallOp np, SmallOp nws]
+                                 emit bci_PUSH_UBX [Op np, SmallOp nws]
 
   PUSH_APPLY_N             -> emit bci_PUSH_APPLY_N []
   PUSH_APPLY_V             -> emit bci_PUSH_APPLY_V []
@@ -388,24 +388,24 @@ assembleI dflags i = case i of
   MKPAP     off sz         -> emit bci_MKPAP [SmallOp off, SmallOp sz]
   UNPACK    n              -> emit bci_UNPACK [SmallOp n]
   PACK      dcon sz        -> do itbl_no <- lit [BCONPtrItbl (getName dcon)]
-                                 emit bci_PACK [SmallOp itbl_no, SmallOp sz]
+                                 emit bci_PACK [Op itbl_no, SmallOp sz]
   LABEL     lbl            -> label lbl
   TESTLT_I  i l            -> do np <- int i
-                                 emit bci_TESTLT_I [SmallOp np, LabelOp l]
+                                 emit bci_TESTLT_I [Op np, LabelOp l]
   TESTEQ_I  i l            -> do np <- int i
-                                 emit bci_TESTEQ_I [SmallOp np, LabelOp l]
+                                 emit bci_TESTEQ_I [Op np, LabelOp l]
   TESTLT_W  w l            -> do np <- word w
-                                 emit bci_TESTLT_W [SmallOp np, LabelOp l]
+                                 emit bci_TESTLT_W [Op np, LabelOp l]
   TESTEQ_W  w l            -> do np <- word w
-                                 emit bci_TESTEQ_W [SmallOp np, LabelOp l]
+                                 emit bci_TESTEQ_W [Op np, LabelOp l]
   TESTLT_F  f l            -> do np <- float f
-                                 emit bci_TESTLT_F [SmallOp np, LabelOp l]
+                                 emit bci_TESTLT_F [Op np, LabelOp l]
   TESTEQ_F  f l            -> do np <- float f
-                                 emit bci_TESTEQ_F [SmallOp np, LabelOp l]
+                                 emit bci_TESTEQ_F [Op np, LabelOp l]
   TESTLT_D  d l            -> do np <- double d
-                                 emit bci_TESTLT_D [SmallOp np, LabelOp l]
+                                 emit bci_TESTLT_D [Op np, LabelOp l]
   TESTEQ_D  d l            -> do np <- double d
-                                 emit bci_TESTEQ_D [SmallOp np, LabelOp l]
+                                 emit bci_TESTEQ_D [Op np, LabelOp l]
   TESTLT_P  i l            -> emit bci_TESTLT_P [SmallOp i, LabelOp l]
   TESTEQ_P  i l            -> emit bci_TESTEQ_P [SmallOp i, LabelOp l]
   CASEFAIL                 -> emit bci_CASEFAIL []
@@ -415,10 +415,10 @@ assembleI dflags i = case i of
   RETURN                   -> emit bci_RETURN []
   RETURN_UBX rep           -> emit (return_ubx rep) []
   CCALL off m_addr i       -> do np <- addr m_addr
-                                 emit bci_CCALL [SmallOp off, SmallOp np, SmallOp i]
+                                 emit bci_CCALL [SmallOp off, Op np, SmallOp i]
   BRK_FUN array index info -> do p1 <- ptr (BCOPtrArray array)
                                  p2 <- ptr (BCOPtrBreakInfo info)
-                                 emit bci_BRK_FUN [SmallOp p1, SmallOp index, SmallOp p2]
+                                 emit bci_BRK_FUN [Op p1, SmallOp index, Op p2]
 
   where
     literal (MachLabel fs (Just sz) _)
diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index 603accd189..d8235b6905 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -39,8 +39,6 @@ import GHC.Arr          ( Array(..), STArray(..) )
 import GHC.IO           ( IO(..) )
 import GHC.Exts
 import GHC.Ptr          ( castPtr )
-
-import Data.Word
 \end{code}
 
 
@@ -109,18 +107,15 @@ linkBCO' ie ce (UnlinkedBCO _ arity insns_barr bitmap literalsSS ptrsSS)
         let n_literals = sizeSS literalsSS
             n_ptrs     = sizeSS ptrsSS
 
-        ptrs_arr <- if n_ptrs > 65535
-                    then panic "linkBCO: >= 64k ptrs"
-                    else mkPtrsArray ie ce (fromIntegral n_ptrs) ptrs
+        ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
 
         let
             !ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
 
             litRange
-             | n_literals > 65535 = panic "linkBCO: >= 64k literals"
              | n_literals > 0     = (0, fromIntegral n_literals - 1)
              | otherwise          = (1, 0)
-            literals_arr :: UArray Word16 Word
+            literals_arr :: UArray Word Word
             literals_arr = listArray litRange linked_literals
             !literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
 
@@ -130,7 +125,7 @@ linkBCO' ie ce (UnlinkedBCO _ arity insns_barr bitmap literalsSS ptrsSS)
 
 
 -- we recursively link any sub-BCOs while making the ptrs array
-mkPtrsArray :: ItblEnv -> ClosureEnv -> Word16 -> [BCOPtr] -> IO (Array Word16 HValue)
+mkPtrsArray :: ItblEnv -> ClosureEnv -> Word -> [BCOPtr] -> IO (Array Word HValue)
 mkPtrsArray ie ce n_ptrs ptrs = do
   let ptrRange = if n_ptrs > 0 then (0, n_ptrs-1) else (1, 0)
   marr <- newArray_ ptrRange
@@ -164,7 +159,7 @@ instance MArray IOArray e IO where
     unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
 
 -- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
-writeArrayBCO :: IOArray Word16 a -> Int -> BCO# -> IO ()
+writeArrayBCO :: IOArray Word a -> Int -> BCO# -> IO ()
 writeArrayBCO (IOArray (STArray _ _ _ marr#)) (I# i#) bco# = IO $ \s# ->
   case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
   (# s#, () #) }
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index a18e7caa8d..d879fd3e77 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -848,9 +848,9 @@ run_BCO:
             int i;
             int size_words;
 
-            arg1_brk_array      = BCO_NEXT;  // 1st arg of break instruction
-            arg2_array_index    = BCO_NEXT;  // 2nd arg of break instruction
-            arg3_freeVars       = BCO_NEXT;  // 3rd arg of break instruction
+            arg1_brk_array      = BCO_GET_LARGE_ARG;  // 1st arg of break instruction
+            arg2_array_index    = BCO_NEXT;           // 2nd arg of break instruction
+            arg3_freeVars       = BCO_GET_LARGE_ARG;  // 3rd arg of break instruction
 
             // check if we are returning from a breakpoint - this info
             // is stored in the flags field of the current TSO
@@ -969,14 +969,14 @@ run_BCO:
 	}
 
 	case bci_PUSH_G: {
-	    int o1 = BCO_NEXT;
+	    int o1 = BCO_GET_LARGE_ARG;
 	    Sp[-1] = BCO_PTR(o1);
 	    Sp -= 1;
 	    goto nextInsn;
 	}
 
 	case bci_PUSH_ALTS: {
-	    int o_bco  = BCO_NEXT;
+	    int o_bco  = BCO_GET_LARGE_ARG;
 	    Sp[-2] = (W_)&stg_ctoi_R1p_info;
 	    Sp[-1] = BCO_PTR(o_bco);
 	    Sp -= 2;
@@ -984,7 +984,7 @@ run_BCO:
 	}
 
 	case bci_PUSH_ALTS_P: {
-	    int o_bco  = BCO_NEXT;
+	    int o_bco  = BCO_GET_LARGE_ARG;
 	    Sp[-2] = (W_)&stg_ctoi_R1unpt_info;
 	    Sp[-1] = BCO_PTR(o_bco);
 	    Sp -= 2;
@@ -992,7 +992,7 @@ run_BCO:
 	}
 
 	case bci_PUSH_ALTS_N: {
-	    int o_bco  = BCO_NEXT;
+	    int o_bco  = BCO_GET_LARGE_ARG;
 	    Sp[-2] = (W_)&stg_ctoi_R1n_info;
 	    Sp[-1] = BCO_PTR(o_bco);
 	    Sp -= 2;
@@ -1000,7 +1000,7 @@ run_BCO:
 	}
 
 	case bci_PUSH_ALTS_F: {
-	    int o_bco  = BCO_NEXT;
+	    int o_bco  = BCO_GET_LARGE_ARG;
 	    Sp[-2] = (W_)&stg_ctoi_F1_info;
 	    Sp[-1] = BCO_PTR(o_bco);
 	    Sp -= 2;
@@ -1008,7 +1008,7 @@ run_BCO:
 	}
 
 	case bci_PUSH_ALTS_D: {
-	    int o_bco  = BCO_NEXT;
+	    int o_bco  = BCO_GET_LARGE_ARG;
 	    Sp[-2] = (W_)&stg_ctoi_D1_info;
 	    Sp[-1] = BCO_PTR(o_bco);
 	    Sp -= 2;
@@ -1016,7 +1016,7 @@ run_BCO:
 	}
 
 	case bci_PUSH_ALTS_L: {
-	    int o_bco  = BCO_NEXT;
+	    int o_bco  = BCO_GET_LARGE_ARG;
 	    Sp[-2] = (W_)&stg_ctoi_L1_info;
 	    Sp[-1] = BCO_PTR(o_bco);
 	    Sp -= 2;
@@ -1024,7 +1024,7 @@ run_BCO:
 	}
 
 	case bci_PUSH_ALTS_V: {
-	    int o_bco  = BCO_NEXT;
+	    int o_bco  = BCO_GET_LARGE_ARG;
 	    Sp[-2] = (W_)&stg_ctoi_V_info;
 	    Sp[-1] = BCO_PTR(o_bco);
 	    Sp -= 2;
@@ -1067,7 +1067,7 @@ run_BCO:
 	    
 	case bci_PUSH_UBX: {
 	    int i;
-	    int o_lits = BCO_NEXT;
+	    int o_lits = BCO_GET_LARGE_ARG;
 	    int n_words = BCO_NEXT;
 	    Sp -= n_words;
 	    for (i = 0; i < n_words; i++) {
@@ -1181,7 +1181,7 @@ run_BCO:
 
 	case bci_PACK: {
 	    int i;
-	    int o_itbl         = BCO_NEXT;
+	    int o_itbl         = BCO_GET_LARGE_ARG;
 	    int n_words        = BCO_NEXT;
 	    StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_LIT(o_itbl));
 	    int request        = CONSTR_sizeW( itbl->layout.payload.ptrs, 
@@ -1224,7 +1224,7 @@ run_BCO:
 
 	case bci_TESTLT_I: {
 	    // There should be an Int at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    I_ stackInt = (I_)Sp[1];
 	    if (stackInt >= (I_)BCO_LIT(discr))
@@ -1234,7 +1234,7 @@ run_BCO:
 
 	case bci_TESTEQ_I: {
 	    // There should be an Int at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    I_ stackInt = (I_)Sp[1];
 	    if (stackInt != (I_)BCO_LIT(discr)) {
@@ -1245,7 +1245,7 @@ run_BCO:
 
 	case bci_TESTLT_W: {
 	    // There should be an Int at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    W_ stackWord = (W_)Sp[1];
 	    if (stackWord >= (W_)BCO_LIT(discr))
@@ -1255,7 +1255,7 @@ run_BCO:
 
 	case bci_TESTEQ_W: {
 	    // There should be an Int at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    W_ stackWord = (W_)Sp[1];
 	    if (stackWord != (W_)BCO_LIT(discr)) {
@@ -1266,7 +1266,7 @@ run_BCO:
 
 	case bci_TESTLT_D: {
 	    // There should be a Double at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    StgDouble stackDbl, discrDbl;
 	    stackDbl = PK_DBL( & Sp[1] );
@@ -1279,7 +1279,7 @@ run_BCO:
 
 	case bci_TESTEQ_D: {
 	    // There should be a Double at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    StgDouble stackDbl, discrDbl;
 	    stackDbl = PK_DBL( & Sp[1] );
@@ -1292,7 +1292,7 @@ run_BCO:
 
 	case bci_TESTLT_F: {
 	    // There should be a Float at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    StgFloat stackFlt, discrFlt;
 	    stackFlt = PK_FLT( & Sp[1] );
@@ -1305,7 +1305,7 @@ run_BCO:
 
 	case bci_TESTEQ_F: {
 	    // There should be a Float at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
+	    int discr   = BCO_GET_LARGE_ARG;
 	    int failto  = BCO_GET_LARGE_ARG;
 	    StgFloat stackFlt, discrFlt;
 	    stackFlt = PK_FLT( & Sp[1] );
@@ -1369,7 +1369,7 @@ run_BCO:
 	case bci_CCALL: {
 	    void *tok;
 	    int stk_offset            = BCO_NEXT;
-	    int o_itbl                = BCO_NEXT;
+	    int o_itbl                = BCO_GET_LARGE_ARG;
 	    int interruptible         = BCO_NEXT;
 	    void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
 	    int ret_dyn_size =