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 =