2 % (c) The University of Glasgow 2000
4 \section[ByteCodeInstrs]{Bytecode instruction definitions}
7 module ByteCodeInstr ( BCInstr(..), ProtoBCO(..),
8 nameOfProtoBCO, bciStackUse ) where
10 #include "HsVersions.h"
16 import PprCore ( pprCoreExpr, pprCoreAlt )
17 import Literal ( Literal )
18 import PrimRep ( PrimRep )
19 import DataCon ( DataCon )
20 import VarSet ( VarSet )
21 import PrimOp ( PrimOp )
22 import Foreign ( Addr )
26 %************************************************************************
28 \subsection{Bytecodes, and Outputery.}
30 %************************************************************************
35 = ProtoBCO a -- name, in some sense
37 -- what the BCO came from
38 (Either [AnnAlt Id VarSet]
40 [Addr] -- malloc'd; free when BCO is GCd
42 nameOfProtoBCO (ProtoBCO nm insns origin malloced) = nm
47 -- Messing with the stack
50 -- Push locals (existing bits of the stack)
51 | PUSH_L Int{-offset-}
52 | PUSH_LL Int Int{-2 offsets-}
53 | PUSH_LLL Int Int Int{-3 offsets-}
55 | PUSH_G (Either Name PrimOp)
56 -- Push an alt continuation
57 | PUSH_AS Name PrimRep -- push alts and BCO_ptr_ret_info
58 -- PrimRep so we know which itbl
60 | PUSH_UBX (Either Literal Addr)
61 Int -- push this int/float/double/addr, NO TAG, on the stack
62 -- Int is # of words to copy from literal pool
63 -- Eitherness reflects the difficulty of dealing with
64 -- MachAddr here, mostly due to the excessive
65 -- (and unnecessary) restrictions imposed by the designers
66 -- of the new Foreign library. In particular it is quite
67 -- impossible to convert an Addr to any other integral type,
68 -- and it appears impossible to get hold of the bits of an
69 -- addr, even though we need to to assemble BCOs.
71 | PUSH_TAG Int -- push this tag on the stack
73 | SLIDE Int{-this many-} Int{-down by this much-}
74 -- To do with the heap
75 | ALLOC Int -- make an AP_UPD with this many payload words, zeroed
76 | MKAP Int{-ptr to AP_UPD is this far down stack-} Int{-# words-}
77 | UNPACK Int -- unpack N ptr words from t.o.s Constr
79 -- unpack N non-ptr words from offset M in constructor
80 -- K words down the stack
82 -- after assembly, the DataCon is an index into the
84 -- For doing case trees
86 | TESTLT_I Int LocalLabel
87 | TESTEQ_I Int LocalLabel
88 | TESTLT_F Float LocalLabel
89 | TESTEQ_F Float LocalLabel
90 | TESTLT_D Double LocalLabel
91 | TESTEQ_D Double LocalLabel
93 -- The Int value is a constructor number and therefore
94 -- stored in the insn stream rather than as an offset into
96 | TESTLT_P Int LocalLabel
97 | TESTEQ_P Int LocalLabel
102 -- For doing calls to C (via glue code generated by ByteCodeFFI)
103 | CCALL Addr -- of the glue code
104 | SWIZZLE Int Int -- to the ptr N words down the stack,
105 -- add M (interpreted as a signed 16-bit entity)
107 -- To Infinity And Beyond
110 -- unboxed value on TOS. Use tag to find underlying ret itbl
111 -- and return as per that.
114 instance Outputable a => Outputable (ProtoBCO a) where
115 ppr (ProtoBCO name instrs origin malloced)
116 = (text "ProtoBCO" <+> ppr name <+> text (show malloced) <> colon)
117 $$ nest 6 (vcat (map ppr instrs))
119 Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
120 Right rhs -> pprCoreExpr (deAnnotate rhs)
122 instance Outputable BCInstr where
123 ppr (STKCHECK n) = text "STKCHECK" <+> int n
124 ppr (ARGCHECK n) = text "ARGCHECK" <+> int n
125 ppr (PUSH_L offset) = text "PUSH_L " <+> int offset
126 ppr (PUSH_LL o1 o2) = text "PUSH_LL " <+> int o1 <+> int o2
127 ppr (PUSH_LLL o1 o2 o3) = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
128 ppr (PUSH_G (Left nm)) = text "PUSH_G " <+> ppr nm
129 ppr (PUSH_G (Right op)) = text "PUSH_G " <+> text "PrelPrimopWrappers."
131 ppr (PUSH_AS nm pk) = text "PUSH_AS " <+> ppr nm <+> ppr pk
133 ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
134 ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
136 ppr (PUSH_TAG n) = text "PUSH_TAG" <+> int n
137 ppr (SLIDE n d) = text "SLIDE " <+> int n <+> int d
138 ppr (ALLOC sz) = text "ALLOC " <+> int sz
139 ppr (MKAP offset sz) = text "MKAP " <+> int sz <+> text "words,"
140 <+> int offset <+> text "stkoff"
141 ppr (UNPACK sz) = text "UNPACK " <+> int sz
142 ppr (UPK_TAG n m k) = text "UPK_TAG " <+> int n <> text "words"
143 <+> int m <> text "conoff"
144 <+> int k <> text "stkoff"
145 ppr (PACK dcon sz) = text "PACK " <+> ppr dcon <+> ppr sz
146 ppr (LABEL lab) = text "__" <> int lab <> colon
147 ppr (TESTLT_I i lab) = text "TESTLT_I" <+> int i <+> text "__" <> int lab
148 ppr (TESTEQ_I i lab) = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
149 ppr (TESTLT_F f lab) = text "TESTLT_F" <+> float f <+> text "__" <> int lab
150 ppr (TESTEQ_F f lab) = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
151 ppr (TESTLT_D d lab) = text "TESTLT_D" <+> double d <+> text "__" <> int lab
152 ppr (TESTEQ_D d lab) = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
153 ppr (TESTLT_P i lab) = text "TESTLT_P" <+> int i <+> text "__" <> int lab
154 ppr (TESTEQ_P i lab) = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
155 ppr (JMP lab) = text "JMP" <+> int lab
156 ppr CASEFAIL = text "CASEFAIL"
157 ppr ENTER = text "ENTER"
158 ppr (RETURN pk) = text "RETURN " <+> ppr pk
159 ppr (CCALL marshall_addr) = text "CCALL " <+> text "marshall code at"
160 <+> text (show marshall_addr)
161 ppr (SWIZZLE stkoff n) = text "SWIZZLE " <+> text "stkoff" <+> int stkoff
162 <+> text "by" <+> int n
164 -- The stack use, in words, of each bytecode insn. These _must_ be
165 -- correct, or overestimates of reality, to be safe.
166 bciStackUse :: BCInstr -> Int
167 bciStackUse (STKCHECK n) = 0
168 bciStackUse (ARGCHECK n) = 0
169 bciStackUse (PUSH_L offset) = 1
170 bciStackUse (PUSH_LL o1 o2) = 2
171 bciStackUse (PUSH_LLL o1 o2 o3) = 3
172 bciStackUse (PUSH_G globalish) = 1
173 bciStackUse (PUSH_AS nm pk) = 2
174 bciStackUse (PUSH_UBX lit nw) = nw
175 bciStackUse (PUSH_TAG n) = 1
176 bciStackUse (ALLOC sz) = 1
177 bciStackUse (UNPACK sz) = sz
178 bciStackUse (UPK_TAG n m k) = n + 1{-tag-}
179 bciStackUse (LABEL lab) = 0
180 bciStackUse (TESTLT_I i lab) = 0
181 bciStackUse (TESTEQ_I i lab) = 0
182 bciStackUse (TESTLT_F f lab) = 0
183 bciStackUse (TESTEQ_F f lab) = 0
184 bciStackUse (TESTLT_D d lab) = 0
185 bciStackUse (TESTEQ_D d lab) = 0
186 bciStackUse (TESTLT_P i lab) = 0
187 bciStackUse (TESTEQ_P i lab) = 0
188 bciStackUse CASEFAIL = 0
189 bciStackUse (JMP lab) = 0
190 bciStackUse ENTER = 0
191 bciStackUse (RETURN pk) = 0
192 bciStackUse (CCALL marshall_addr) = 0
193 bciStackUse (SWIZZLE stkoff n) = 0
195 -- These insns actually reduce stack use, but we need the high-tide level,
196 -- so can't use this info. Not that it matters much.
197 bciStackUse (SLIDE n d) = 0
198 bciStackUse (MKAP offset sz) = 0
199 bciStackUse (PACK dcon sz) = 1 -- worst case is PACK 0 words