Commit 3a8cc90c authored by sewardj's avatar sewardj

[project @ 2001-02-06 12:00:17 by sewardj]

Support stack overflow checks in interpreted code.  The deal is:
* If a BCO is reckoned to need less than iNTERP_STACK_CHECK_THRESH
  words of stack, no stack check insn is added.
* If a BCO needs >= iNTERP_STACK_CHECK_THRESH words, an explicit
  check insn is added.

The interpreter ensures at least iNTERP_STACK_CHECK_THRESH words of
stack are available before running each BCO, regardless of whether or
not the BCO contains an explicit check insn too.

By setting iNTERP_STACK_CHECK_THRESH to a suitably large level
(currently 50), most BCOs only require the implicit stack check, which
avoids the overhead of decoding one extra insn per BCO.  BCOs which do
have a stack check insn then do 2 stack checks rather than 1
(implicit, then explicit), but this is rare enough that we don't care.
parent 86cce087
......@@ -39,10 +39,11 @@ import ErrUtils ( showPass, dumpIfSet_dyn )
import Unique ( mkPseudoUnique3 )
import FastString ( FastString(..) )
import PprType ( pprType )
import ByteCodeInstr ( BCInstr(..), ProtoBCO(..), nameOfProtoBCO )
import ByteCodeInstr ( BCInstr(..), ProtoBCO(..), nameOfProtoBCO, bciStackUse )
import ByteCodeItbls ( ItblEnv, mkITbls )
import ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
ClosureEnv, HValue, linkSomeBCOs, filterNameMap )
ClosureEnv, HValue, linkSomeBCOs, filterNameMap,
iNTERP_STACK_CHECK_THRESH )
import List ( intersperse, sortBy )
import Foreign ( Ptr(..), mallocBytes )
......@@ -169,8 +170,31 @@ ppBCEnv p
-- Create a BCO and do a spot of peephole optimisation on the insns
-- at the same time.
mkProtoBCO nm instrs_ordlist origin
= ProtoBCO nm (peep (fromOL instrs_ordlist)) origin
= ProtoBCO nm maybe_with_stack_check origin
where
-- Overestimate the stack usage (in words) of this BCO,
-- and if >= iNTERP_STACK_CHECK_THRESH, add an explicit
-- stack check. (The interpreter always does a stack check
-- for iNTERP_STACK_CHECK_THRESH words at the start of each
-- BCO anyway, so we only need to add an explicit on in the
-- (hopefully rare) cases when the (overestimated) stack use
-- exceeds iNTERP_STACK_CHECK_THRESH.
maybe_with_stack_check
| 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
stack_overest = sum (map bciStackUse peep_d)
+ 10 {- just to be really really sure -}
-- Merge local pushes
peep_d = peep (fromOL instrs_ordlist)
peep (PUSH_L off1 : PUSH_L off2 : PUSH_L off3 : rest)
= PUSH_LLL off1 (off2-1) (off3-2) : peep rest
peep (PUSH_L off1 : PUSH_L off2 : rest)
......
......@@ -4,7 +4,8 @@
\section[ByteCodeInstrs]{Bytecode instruction definitions}
\begin{code}
module ByteCodeInstr ( BCInstr(..), ProtoBCO(..), nameOfProtoBCO ) where
module ByteCodeInstr ( BCInstr(..), ProtoBCO(..),
nameOfProtoBCO, bciStackUse ) where
#include "HsVersions.h"
......@@ -43,6 +44,7 @@ type LocalLabel = Int
data BCInstr
-- Messing with the stack
= ARGCHECK Int
| STKCHECK Int
-- Push locals (existing bits of the stack)
| PUSH_L Int{-offset-}
| PUSH_LL Int Int{-2 offsets-}
......@@ -92,7 +94,16 @@ data BCInstr
-- and return as per that.
instance Outputable a => Outputable (ProtoBCO a) where
ppr (ProtoBCO name instrs origin)
= (text "ProtoBCO" <+> ppr name <> colon)
$$ nest 6 (vcat (map ppr instrs))
$$ case origin of
Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
Right rhs -> pprCoreExpr (deAnnotate rhs)
instance Outputable BCInstr where
ppr (STKCHECK n) = text "STKCHECK" <+> int n
ppr (ARGCHECK n) = text "ARGCHECK" <+> int n
ppr (PUSH_L offset) = text "PUSH_L " <+> int offset
ppr (PUSH_LL o1 o2) = text "PUSH_LL " <+> int o1 <+> int o2
......@@ -125,11 +136,39 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
instance Outputable a => Outputable (ProtoBCO a) where
ppr (ProtoBCO name instrs origin)
= (text "ProtoBCO" <+> ppr name <> colon)
$$ nest 6 (vcat (map ppr instrs))
$$ case origin of
Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
Right rhs -> pprCoreExpr (deAnnotate rhs)
-- The stack use, in words, of each bytecode insn. These _must_ be
-- correct, or overestimates of reality, to be safe.
bciStackUse :: BCInstr -> Int
bciStackUse (STKCHECK n) = 0
bciStackUse (ARGCHECK n) = 0
bciStackUse (PUSH_L offset) = 1
bciStackUse (PUSH_LL o1 o2) = 2
bciStackUse (PUSH_LLL o1 o2 o3) = 3
bciStackUse (PUSH_G globalish) = 1
bciStackUse (PUSH_AS nm pk) = 2
bciStackUse (PUSH_UBX lit nw) = nw
bciStackUse (PUSH_TAG n) = 1
bciStackUse (ALLOC sz) = 1
bciStackUse (UNPACK sz) = sz
bciStackUse (UPK_TAG n m k) = n + 1{-tag-}
bciStackUse (LABEL lab) = 0
bciStackUse (TESTLT_I i lab) = 0
bciStackUse (TESTEQ_I i lab) = 0
bciStackUse (TESTLT_F f lab) = 0
bciStackUse (TESTEQ_F f lab) = 0
bciStackUse (TESTLT_D d lab) = 0
bciStackUse (TESTEQ_D d lab) = 0
bciStackUse (TESTLT_P i lab) = 0
bciStackUse (TESTEQ_P i lab) = 0
bciStackUse CASEFAIL = 0
bciStackUse ENTER = 0
bciStackUse (RETURN pk) = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
bciStackUse (SLIDE n d) = 0
bciStackUse (MKAP offset sz) = 0
bciStackUse (PACK dcon sz) = 1 -- worst case is PACK 0 words
\end{code}
......@@ -5,7 +5,8 @@
\begin{code}
module ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
ClosureEnv, HValue, linkSomeBCOs, filterNameMap
ClosureEnv, HValue, linkSomeBCOs, filterNameMap,
iNTERP_STACK_CHECK_THRESH
) where
#include "HsVersions.h"
......@@ -188,6 +189,7 @@ mkBits findLabel st proto_insns
doInstr st i
= case i of
ARGCHECK n -> instr2 st i_ARGCHECK n
STKCHECK n -> instr2 st i_STKCHECK n
PUSH_L o1 -> instr2 st i_PUSH_L o1
PUSH_LL o1 o2 -> instr3 st i_PUSH_LL o1 o2
PUSH_LLL o1 o2 o3 -> instr4 st i_PUSH_LLL o1 o2 o3
......@@ -320,6 +322,7 @@ foreign label "stg_gc_d1_info" stg_gc_d1_info :: Addr
instrSize16s :: BCInstr -> Int
instrSize16s instr
= case instr of
STKCHECK _ -> 2
ARGCHECK _ -> 2
PUSH_L _ -> 2
PUSH_LL _ _ -> 3
......@@ -553,5 +556,8 @@ i_TESTEQ_P = (bci_TESTEQ_P :: Int)
i_CASEFAIL = (bci_CASEFAIL :: Int)
i_ENTER = (bci_ENTER :: Int)
i_RETURN = (bci_RETURN :: Int)
i_STKCHECK = (bci_STKCHECK :: Int)
iNTERP_STACK_CHECK_THRESH = (INTERP_STACK_CHECK_THRESH :: Int)
\end{code}
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