Ticket #3867: 0004-Implemented-word-sized-addressing-of-pointers-and-li.patch

File 0004-Implemented-word-sized-addressing-of-pointers-and-li.patch, 14.5 KB (added by pcapriotti, 3 years ago)
  • compiler/ghci/ByteCodeAsm.lhs

    From f7c3fe76c7ba9cd1485b244b96055ca472ccd173 Mon Sep 17 00:00:00 2001
    From: Paolo Capriotti <[email protected]>
    Date: Thu, 5 Apr 2012 18:42:37 +0100
    Subject: [PATCH 4/4] Implemented word-sized addressing of pointers and
     literals.
    
    ---
     compiler/ghci/ByteCodeAsm.lhs  |   50 ++++++++++++++++++++--------------------
     compiler/ghci/ByteCodeLink.lhs |   11 +++-----
     rts/Interpreter.c              |   44 +++++++++++++++++-----------------
     3 files changed, 51 insertions(+), 54 deletions(-)
    
    diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
    index 3119447..91bcd43 100644
    a b data Operand 
    216216  | LabelOp Word16
    217217
    218218data Assembler a
    219   = AllocPtr (IO BCOPtr) (Word16 -> Assembler a)
    220   | AllocLit [BCONPtr] (Word16 -> Assembler a)
     219  = AllocPtr (IO BCOPtr) (Word -> Assembler a)
     220  | AllocLit [BCONPtr] (Word -> Assembler a)
    221221  | AllocLabel Word16 (Assembler a)
    222222  | Emit Word16 [Operand] (Assembler a)
    223223  | NullAsm a
    instance Monad Assembler where 
    230230  AllocLabel lbl k >>= f = AllocLabel lbl (k >>= f)
    231231  Emit w ops k >>= f = Emit w ops (k >>= f)
    232232
    233 ioptr :: IO BCOPtr -> Assembler Word16
     233ioptr :: IO BCOPtr -> Assembler Word
    234234ioptr p = AllocPtr p return
    235235
    236 ptr :: BCOPtr -> Assembler Word16
     236ptr :: BCOPtr -> Assembler Word
    237237ptr = ioptr . return
    238238
    239 lit :: [BCONPtr] -> Assembler Word16
     239lit :: [BCONPtr] -> Assembler Word
    240240lit l = AllocLit l return
    241241
    242242label :: Word16 -> Assembler ()
    runAsm e (AllocPtr p_io k) = do 
    253253  p <- lift p_io
    254254  w <- State $ \(st_i0,st_l0,st_p0) -> do
    255255    let st_p1 = addToSS st_p0 p
    256     return ((st_i0,st_l0,st_p1), sizeSS16 st_p0)
     256    return ((st_i0,st_l0,st_p1), sizeSS st_p0)
    257257  runAsm e $ k w
    258258runAsm e (AllocLit lits k) = do
    259259  w <- State $ \(st_i0,st_l0,st_p0) -> do
    260260    let st_l1 = addListToSS st_l0 lits
    261     return ((st_i0,st_l1,st_p0), sizeSS16 st_l0)
     261    return ((st_i0,st_l1,st_p0), sizeSS st_l0)
    262262  runAsm e $ k w
    263263runAsm e (AllocLabel _ k) = runAsm e k
    264264runAsm e (Emit w ops k) = do
    assembleI dflags i = case i of 
    350350  PUSH_LL o1 o2            -> emit bci_PUSH_LL [SmallOp o1, SmallOp o2]
    351351  PUSH_LLL o1 o2 o3        -> emit bci_PUSH_LLL [SmallOp o1, SmallOp o2, SmallOp o3]
    352352  PUSH_G nm                -> do p <- ptr (BCOPtrName nm)
    353                                  emit bci_PUSH_G [SmallOp p]
     353                                 emit bci_PUSH_G [Op p]
    354354  PUSH_PRIMOP op           -> do p <- ptr (BCOPtrPrimOp op)
    355                                  emit bci_PUSH_G [SmallOp p]
     355                                 emit bci_PUSH_G [Op p]
    356356  PUSH_BCO proto           -> do let ul_bco = assembleBCO dflags proto
    357357                                 p <- ioptr (liftM BCOPtrBCO ul_bco)
    358                                  emit bci_PUSH_G [SmallOp p]
     358                                 emit bci_PUSH_G [Op p]
    359359  PUSH_ALTS proto          -> do let ul_bco = assembleBCO dflags proto
    360360                                 p <- ioptr (liftM BCOPtrBCO ul_bco)
    361                                  emit bci_PUSH_ALTS [SmallOp p]
     361                                 emit bci_PUSH_ALTS [Op p]
    362362  PUSH_ALTS_UNLIFTED proto pk
    363363                           -> do let ul_bco = assembleBCO dflags proto
    364364                                 p <- ioptr (liftM BCOPtrBCO ul_bco)
    365                                  emit (push_alts pk) [SmallOp p]
     365                                 emit (push_alts pk) [Op p]
    366366  PUSH_UBX (Left lit) nws  -> do np <- literal lit
    367                                  emit bci_PUSH_UBX [SmallOp np, SmallOp nws]
     367                                 emit bci_PUSH_UBX [Op np, SmallOp nws]
    368368  PUSH_UBX (Right aa) nws  -> do np <- addr aa
    369                                  emit bci_PUSH_UBX [SmallOp np, SmallOp nws]
     369                                 emit bci_PUSH_UBX [Op np, SmallOp nws]
    370370
    371371  PUSH_APPLY_N             -> emit bci_PUSH_APPLY_N []
    372372  PUSH_APPLY_V             -> emit bci_PUSH_APPLY_V []
    assembleI dflags i = case i of 
    388388  MKPAP     off sz         -> emit bci_MKPAP [SmallOp off, SmallOp sz]
    389389  UNPACK    n              -> emit bci_UNPACK [SmallOp n]
    390390  PACK      dcon sz        -> do itbl_no <- lit [BCONPtrItbl (getName dcon)]
    391                                  emit bci_PACK [SmallOp itbl_no, SmallOp sz]
     391                                 emit bci_PACK [Op itbl_no, SmallOp sz]
    392392  LABEL     lbl            -> label lbl
    393393  TESTLT_I  i l            -> do np <- int i
    394                                  emit bci_TESTLT_I [SmallOp np, LabelOp l]
     394                                 emit bci_TESTLT_I [Op np, LabelOp l]
    395395  TESTEQ_I  i l            -> do np <- int i
    396                                  emit bci_TESTEQ_I [SmallOp np, LabelOp l]
     396                                 emit bci_TESTEQ_I [Op np, LabelOp l]
    397397  TESTLT_W  w l            -> do np <- word w
    398                                  emit bci_TESTLT_W [SmallOp np, LabelOp l]
     398                                 emit bci_TESTLT_W [Op np, LabelOp l]
    399399  TESTEQ_W  w l            -> do np <- word w
    400                                  emit bci_TESTEQ_W [SmallOp np, LabelOp l]
     400                                 emit bci_TESTEQ_W [Op np, LabelOp l]
    401401  TESTLT_F  f l            -> do np <- float f
    402                                  emit bci_TESTLT_F [SmallOp np, LabelOp l]
     402                                 emit bci_TESTLT_F [Op np, LabelOp l]
    403403  TESTEQ_F  f l            -> do np <- float f
    404                                  emit bci_TESTEQ_F [SmallOp np, LabelOp l]
     404                                 emit bci_TESTEQ_F [Op np, LabelOp l]
    405405  TESTLT_D  d l            -> do np <- double d
    406                                  emit bci_TESTLT_D [SmallOp np, LabelOp l]
     406                                 emit bci_TESTLT_D [Op np, LabelOp l]
    407407  TESTEQ_D  d l            -> do np <- double d
    408                                  emit bci_TESTEQ_D [SmallOp np, LabelOp l]
     408                                 emit bci_TESTEQ_D [Op np, LabelOp l]
    409409  TESTLT_P  i l            -> emit bci_TESTLT_P [SmallOp i, LabelOp l]
    410410  TESTEQ_P  i l            -> emit bci_TESTEQ_P [SmallOp i, LabelOp l]
    411411  CASEFAIL                 -> emit bci_CASEFAIL []
    assembleI dflags i = case i of 
    415415  RETURN                   -> emit bci_RETURN []
    416416  RETURN_UBX rep           -> emit (return_ubx rep) []
    417417  CCALL off m_addr i       -> do np <- addr m_addr
    418                                  emit bci_CCALL [SmallOp off, SmallOp np, SmallOp i]
     418                                 emit bci_CCALL [SmallOp off, Op np, SmallOp i]
    419419  BRK_FUN array index info -> do p1 <- ptr (BCOPtrArray array)
    420420                                 p2 <- ptr (BCOPtrBreakInfo info)
    421                                  emit bci_BRK_FUN [SmallOp p1, SmallOp index, SmallOp p2]
     421                                 emit bci_BRK_FUN [Op p1, SmallOp index, Op p2]
    422422
    423423  where
    424424    literal (MachLabel fs (Just sz) _)
  • compiler/ghci/ByteCodeLink.lhs

    diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
    index 603accd..c7542d3 100644
    a b linkBCO' ie ce (UnlinkedBCO _ arity insns_barr bitmap literalsSS ptrsSS) 
    109109        let n_literals = sizeSS literalsSS
    110110            n_ptrs     = sizeSS ptrsSS
    111111
    112         ptrs_arr <- if n_ptrs > 65535
    113                     then panic "linkBCO: >= 64k ptrs"
    114                     else mkPtrsArray ie ce (fromIntegral n_ptrs) ptrs
     112        ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
    115113
    116114        let
    117115            !ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
    118116
    119117            litRange
    120              | n_literals > 65535 = panic "linkBCO: >= 64k literals"
    121118             | n_literals > 0     = (0, fromIntegral n_literals - 1)
    122119             | otherwise          = (1, 0)
    123             literals_arr :: UArray Word16 Word
     120            literals_arr :: UArray Word Word
    124121            literals_arr = listArray litRange linked_literals
    125122            !literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
    126123
    linkBCO' ie ce (UnlinkedBCO _ arity insns_barr bitmap literalsSS ptrsSS) 
    130127
    131128
    132129-- we recursively link any sub-BCOs while making the ptrs array
    133 mkPtrsArray :: ItblEnv -> ClosureEnv -> Word16 -> [BCOPtr] -> IO (Array Word16 HValue)
     130mkPtrsArray :: ItblEnv -> ClosureEnv -> Word -> [BCOPtr] -> IO (Array Word HValue)
    134131mkPtrsArray ie ce n_ptrs ptrs = do
    135132  let ptrRange = if n_ptrs > 0 then (0, n_ptrs-1) else (1, 0)
    136133  marr <- newArray_ ptrRange
    instance MArray IOArray e IO where 
    164161    unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
    165162
    166163-- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
    167 writeArrayBCO :: IOArray Word16 a -> Int -> BCO# -> IO ()
     164writeArrayBCO :: IOArray Word a -> Int -> BCO# -> IO ()
    168165writeArrayBCO (IOArray (STArray _ _ _ marr#)) (I# i#) bco# = IO $ \s# ->
    169166  case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
    170167  (# s#, () #) }
  • rts/Interpreter.c

    diff --git a/rts/Interpreter.c b/rts/Interpreter.c
    index a18e7ca..d879fd3 100644
    a b run_BCO: 
    848848            int i;
    849849            int size_words;
    850850
    851             arg1_brk_array      = BCO_NEXT;  // 1st arg of break instruction
    852             arg2_array_index    = BCO_NEXT;  // 2nd arg of break instruction
    853             arg3_freeVars       = BCO_NEXT;  // 3rd arg of break instruction
     851            arg1_brk_array      = BCO_GET_LARGE_ARG;  // 1st arg of break instruction
     852            arg2_array_index    = BCO_NEXT;           // 2nd arg of break instruction
     853            arg3_freeVars       = BCO_GET_LARGE_ARG;  // 3rd arg of break instruction
    854854
    855855            // check if we are returning from a breakpoint - this info
    856856            // is stored in the flags field of the current TSO
    run_BCO: 
    969969        }
    970970
    971971        case bci_PUSH_G: {
    972             int o1 = BCO_NEXT;
     972            int o1 = BCO_GET_LARGE_ARG;
    973973            Sp[-1] = BCO_PTR(o1);
    974974            Sp -= 1;
    975975            goto nextInsn;
    976976        }
    977977
    978978        case bci_PUSH_ALTS: {
    979             int o_bco  = BCO_NEXT;
     979            int o_bco  = BCO_GET_LARGE_ARG;
    980980            Sp[-2] = (W_)&stg_ctoi_R1p_info;
    981981            Sp[-1] = BCO_PTR(o_bco);
    982982            Sp -= 2;
    run_BCO: 
    984984        }
    985985
    986986        case bci_PUSH_ALTS_P: {
    987             int o_bco  = BCO_NEXT;
     987            int o_bco  = BCO_GET_LARGE_ARG;
    988988            Sp[-2] = (W_)&stg_ctoi_R1unpt_info;
    989989            Sp[-1] = BCO_PTR(o_bco);
    990990            Sp -= 2;
    run_BCO: 
    992992        }
    993993
    994994        case bci_PUSH_ALTS_N: {
    995             int o_bco  = BCO_NEXT;
     995            int o_bco  = BCO_GET_LARGE_ARG;
    996996            Sp[-2] = (W_)&stg_ctoi_R1n_info;
    997997            Sp[-1] = BCO_PTR(o_bco);
    998998            Sp -= 2;
    run_BCO: 
    10001000        }
    10011001
    10021002        case bci_PUSH_ALTS_F: {
    1003             int o_bco  = BCO_NEXT;
     1003            int o_bco  = BCO_GET_LARGE_ARG;
    10041004            Sp[-2] = (W_)&stg_ctoi_F1_info;
    10051005            Sp[-1] = BCO_PTR(o_bco);
    10061006            Sp -= 2;
    run_BCO: 
    10081008        }
    10091009
    10101010        case bci_PUSH_ALTS_D: {
    1011             int o_bco  = BCO_NEXT;
     1011            int o_bco  = BCO_GET_LARGE_ARG;
    10121012            Sp[-2] = (W_)&stg_ctoi_D1_info;
    10131013            Sp[-1] = BCO_PTR(o_bco);
    10141014            Sp -= 2;
    run_BCO: 
    10161016        }
    10171017
    10181018        case bci_PUSH_ALTS_L: {
    1019             int o_bco  = BCO_NEXT;
     1019            int o_bco  = BCO_GET_LARGE_ARG;
    10201020            Sp[-2] = (W_)&stg_ctoi_L1_info;
    10211021            Sp[-1] = BCO_PTR(o_bco);
    10221022            Sp -= 2;
    run_BCO: 
    10241024        }
    10251025
    10261026        case bci_PUSH_ALTS_V: {
    1027             int o_bco  = BCO_NEXT;
     1027            int o_bco  = BCO_GET_LARGE_ARG;
    10281028            Sp[-2] = (W_)&stg_ctoi_V_info;
    10291029            Sp[-1] = BCO_PTR(o_bco);
    10301030            Sp -= 2;
    run_BCO: 
    10671067           
    10681068        case bci_PUSH_UBX: {
    10691069            int i;
    1070             int o_lits = BCO_NEXT;
     1070            int o_lits = BCO_GET_LARGE_ARG;
    10711071            int n_words = BCO_NEXT;
    10721072            Sp -= n_words;
    10731073            for (i = 0; i < n_words; i++) {
    run_BCO: 
    11811181
    11821182        case bci_PACK: {
    11831183            int i;
    1184             int o_itbl         = BCO_NEXT;
     1184            int o_itbl         = BCO_GET_LARGE_ARG;
    11851185            int n_words        = BCO_NEXT;
    11861186            StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_LIT(o_itbl));
    11871187            int request        = CONSTR_sizeW( itbl->layout.payload.ptrs,
    run_BCO: 
    12241224
    12251225        case bci_TESTLT_I: {
    12261226            // There should be an Int at Sp[1], and an info table at Sp[0].
    1227             int discr   = BCO_NEXT;
     1227            int discr   = BCO_GET_LARGE_ARG;
    12281228            int failto  = BCO_GET_LARGE_ARG;
    12291229            I_ stackInt = (I_)Sp[1];
    12301230            if (stackInt >= (I_)BCO_LIT(discr))
    run_BCO: 
    12341234
    12351235        case bci_TESTEQ_I: {
    12361236            // There should be an Int at Sp[1], and an info table at Sp[0].
    1237             int discr   = BCO_NEXT;
     1237            int discr   = BCO_GET_LARGE_ARG;
    12381238            int failto  = BCO_GET_LARGE_ARG;
    12391239            I_ stackInt = (I_)Sp[1];
    12401240            if (stackInt != (I_)BCO_LIT(discr)) {
    run_BCO: 
    12451245
    12461246        case bci_TESTLT_W: {
    12471247            // There should be an Int at Sp[1], and an info table at Sp[0].
    1248             int discr   = BCO_NEXT;
     1248            int discr   = BCO_GET_LARGE_ARG;
    12491249            int failto  = BCO_GET_LARGE_ARG;
    12501250            W_ stackWord = (W_)Sp[1];
    12511251            if (stackWord >= (W_)BCO_LIT(discr))
    run_BCO: 
    12551255
    12561256        case bci_TESTEQ_W: {
    12571257            // There should be an Int at Sp[1], and an info table at Sp[0].
    1258             int discr   = BCO_NEXT;
     1258            int discr   = BCO_GET_LARGE_ARG;
    12591259            int failto  = BCO_GET_LARGE_ARG;
    12601260            W_ stackWord = (W_)Sp[1];
    12611261            if (stackWord != (W_)BCO_LIT(discr)) {
    run_BCO: 
    12661266
    12671267        case bci_TESTLT_D: {
    12681268            // There should be a Double at Sp[1], and an info table at Sp[0].
    1269             int discr   = BCO_NEXT;
     1269            int discr   = BCO_GET_LARGE_ARG;
    12701270            int failto  = BCO_GET_LARGE_ARG;
    12711271            StgDouble stackDbl, discrDbl;
    12721272            stackDbl = PK_DBL( & Sp[1] );
    run_BCO: 
    12791279
    12801280        case bci_TESTEQ_D: {
    12811281            // There should be a Double at Sp[1], and an info table at Sp[0].
    1282             int discr   = BCO_NEXT;
     1282            int discr   = BCO_GET_LARGE_ARG;
    12831283            int failto  = BCO_GET_LARGE_ARG;
    12841284            StgDouble stackDbl, discrDbl;
    12851285            stackDbl = PK_DBL( & Sp[1] );
    run_BCO: 
    12921292
    12931293        case bci_TESTLT_F: {
    12941294            // There should be a Float at Sp[1], and an info table at Sp[0].
    1295             int discr   = BCO_NEXT;
     1295            int discr   = BCO_GET_LARGE_ARG;
    12961296            int failto  = BCO_GET_LARGE_ARG;
    12971297            StgFloat stackFlt, discrFlt;
    12981298            stackFlt = PK_FLT( & Sp[1] );
    run_BCO: 
    13051305
    13061306        case bci_TESTEQ_F: {
    13071307            // There should be a Float at Sp[1], and an info table at Sp[0].
    1308             int discr   = BCO_NEXT;
     1308            int discr   = BCO_GET_LARGE_ARG;
    13091309            int failto  = BCO_GET_LARGE_ARG;
    13101310            StgFloat stackFlt, discrFlt;
    13111311            stackFlt = PK_FLT( & Sp[1] );
    run_BCO: 
    13691369        case bci_CCALL: {
    13701370            void *tok;
    13711371            int stk_offset            = BCO_NEXT;
    1372             int o_itbl                = BCO_NEXT;
     1372            int o_itbl                = BCO_GET_LARGE_ARG;
    13731373            int interruptible         = BCO_NEXT;
    13741374            void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
    13751375            int ret_dyn_size =