Commit f2363290 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Allow a word-sized argument for STKCHECK

parent 49fd39a1
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment