From f2363290372453038d1ad85b8a71b206a8fcac3e Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Thu, 21 Dec 2006 02:38:25 +0000 Subject: [PATCH] Allow a word-sized argument for STKCHECK --- compiler/ghci/ByteCodeAsm.lhs | 27 ++++++++++++++++++++++++++- compiler/ghci/ByteCodeGen.lhs | 4 +--- includes/Bytecodes.h | 4 ++++ rts/Interpreter.c | 21 +++++++++++++++++++-- 4 files changed, 50 insertions(+), 6 deletions(-) diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index e1346a9..f1f5c8a 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -42,6 +42,7 @@ import Data.Array.Unboxed ( listArray ) import Data.Array.Base ( UArray(..) ) import Data.Array.ST ( castSTUArray ) import Foreign ( Word16, free ) +import Data.Bits import Data.Int ( Int64 ) import Data.Char ( ord ) @@ -202,6 +203,21 @@ sizeSS (SizedSeq n r_xs) = n -- Bring in all the bci_ bytecode constants. #include "Bytecodes.h" +largeArgInstr :: Int -> Int +largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci + +largeArg :: Int -> [Int] +largeArg i + | wORD_SIZE_IN_BITS == 64 + = [(i .&. 0xFFFF000000000000) `shiftR` 48, + (i .&. 0x0000FFFF00000000) `shiftR` 32, + (i .&. 0x00000000FFFF0000) `shiftR` 16, + (i .&. 0x000000000000FFFF)] + | wORD_SIZE_IN_BITS == 32 + = [(i .&. 0xFFFF0000) `shiftR` 16, + (i .&. 0x0000FFFF)] + | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?" + -- This is where all the action is (pass 2 of the assembler) mkBits :: (Int -> Int) -- label finder -> AsmState @@ -214,7 +230,10 @@ mkBits findLabel st proto_insns doInstr :: AsmState -> BCInstr -> IO AsmState doInstr st i = case i of - STKCHECK n -> instr2 st bci_STKCHECK n + STKCHECK n + | n > 65535 -> + instrn st (largeArgInstr bci_STKCHECK : largeArg n) + | otherwise -> instr2 st bci_STKCHECK n PUSH_L o1 -> instr2 st bci_PUSH_L o1 PUSH_LL o1 o2 -> instr3 st bci_PUSH_LL o1 o2 PUSH_LLL o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3 @@ -286,6 +305,12 @@ mkBits findLabel st proto_insns i2s :: Int -> Word16 i2s = fromIntegral + instrn :: AsmState -> [Int] -> IO AsmState + instrn st [] = return st + instrn (st_i, st_l, st_p, st_I) (i:is) + = do st_i' <- addToSS st_i (i2s i) + instrn (st_i', st_l, st_p, st_I) is + instr1 (st_i0,st_l0,st_p0,st_I0) i1 = do st_i1 <- addToSS st_i0 i1 return (st_i1,st_l0,st_p0,st_I0) diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 72ad7df..bfc7d75 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -165,14 +165,12 @@ mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap -- don't do stack checks at return points; -- everything is aggregated up to the top BCO -- (which must be a function) - | stack_overest >= 65535 - = pprPanic "mkProtoBCO: stack use won't fit in 16 bits" - (int stack_overest) | stack_overest >= iNTERP_STACK_CHECK_THRESH = STKCHECK stack_overest : peep_d | otherwise = peep_d -- the supposedly common case + -- We assume that this sum doesn't wrap stack_overest = sum (map bciStackUse peep_d) -- Merge local pushes diff --git a/includes/Bytecodes.h b/includes/Bytecodes.h index 73003a3..4a75b00 100644 --- a/includes/Bytecodes.h +++ b/includes/Bytecodes.h @@ -75,6 +75,10 @@ #define bci_RETURN_D 50 #define bci_RETURN_L 51 #define bci_RETURN_V 52 +/* If you need to go past 255 then you will run into the flags */ + +/* If you need to go below 0x0100 then you will run into the instructions */ +#define bci_FLAG_LARGE_ARGS 0x8000 /* If a BCO definitely requires less than this many words of stack, don't include an explicit STKCHECK insn in it. The interpreter diff --git a/rts/Interpreter.c b/rts/Interpreter.c index fba9e3f..b4ef171 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -41,6 +41,17 @@ /* Sp points to the lowest live word on the stack. */ #define BCO_NEXT instrs[bciPtr++] +#define BCO_NEXT_32 (bciPtr += 2, (((StgWord) instrs[bciPtr-2]) << 16) + ((StgWord) instrs[bciPtr-1])) +#define BCO_NEXT_64 (bciPtr += 4, (((StgWord) instrs[bciPtr-4]) << 48) + (((StgWord) instrs[bciPtr-3]) << 32) + (((StgWord) instrs[bciPtr-2]) << 16) + ((StgWord) instrs[bciPtr-1])) +#if WORD_SIZE_IN_BITS == 32 +#define BCO_NEXT_WORD BCO_NEXT_32 +#elif WORD_SIZE_IN_BITS == 64 +#define BCO_NEXT_WORD BCO_NEXT_64 +#else +#error Can't cope with WORD_SIZE_IN_BITS being nether 32 nor 64 +#endif +#define BCO_GET_LARGE_ARG ((bci & bci_FLAG_LARGE_ARGS) ? BCO_NEXT_WORD : BCO_NEXT) + #define BCO_PTR(n) (W_)ptrs[n] #define BCO_LIT(n) literals[n] #define BCO_ITBL(n) itbls[n] @@ -713,6 +724,7 @@ run_BCO: INTERP_TICK(it_BCO_entries); { register int bciPtr = 1; /* instruction pointer */ + register StgWord16 bci; register StgBCO* bco = (StgBCO*)obj; register StgWord16* instrs = (StgWord16*)(bco->instrs->payload); register StgWord* literals = (StgWord*)(&bco->literals->payload[0]); @@ -753,13 +765,18 @@ run_BCO: it_lastopc = (int)instrs[bciPtr]; #endif - switch (BCO_NEXT) { + bci = BCO_NEXT; + /* We use the high 8 bits for flags, only the highest of which is + * currently allocated */ + ASSERT((bci & 0xFF00) == (bci & 0x8000)); + + switch (bci & 0xFF) { case bci_STKCHECK: { // Explicit stack check at the beginning of a function // *only* (stack checks in case alternatives are // propagated to the enclosing function). - int stk_words_reqd = BCO_NEXT + 1; + StgWord stk_words_reqd = BCO_GET_LARGE_ARG + 1; if (Sp - stk_words_reqd < SpLim) { Sp -= 2; Sp[1] = (W_)obj; -- 1.7.10.4