+-- Non-value trees; ones executed for their side-effect.
+data StixStmt
+
+ = -- Directive for the assembler to change segment
+ StSegment CodeSegment
+
+ -- Assembly-language comments
+ | StComment FastString
+
+ -- Assignments are typed to determine size and register placement.
+ -- Assign a value to a StixReg
+ | StAssignReg PrimRep StixReg StixExpr
+
+ -- Assign a value to memory. First tree indicates the address to be
+ -- assigned to, so there is an implicit dereference here.
+ | StAssignMem PrimRep StixExpr StixExpr -- dst, src
+
+ -- A simple assembly label that we might jump to.
+ | StLabel CLabel
+
+ -- A function header and footer
+ | StFunBegin CLabel
+ | StFunEnd CLabel
+
+ -- An unconditional jump. This instruction may or may not jump
+ -- out of the register allocation domain (basic block, more or
+ -- less). For correct register allocation when this insn is used
+ -- to jump through a jump table, we optionally allow a list of
+ -- the exact targets to be attached, so that the allocator can
+ -- easily construct the exact flow edges leaving this insn.
+ -- Dynamic targets are allowed.
+ | StJump DestInfo StixExpr
+
+ -- A fall-through, from slow to fast
+ | StFallThrough CLabel
+
+ -- A conditional jump. This instruction can be non-terminal :-)
+ -- Only static, local, forward labels are allowed
+ | StCondJump CLabel StixExpr
+
+ -- Raw data (as in an info table).
+ | StData PrimRep [StixExpr]
+ -- String which has been lifted to the top level (sigh).
+ | StDataString FastString
+
+ -- A value computed only for its side effects; result is discarded
+ -- (A handy trapdoor to allow CCalls with no results to appear as
+ -- statements).
+ | StVoidable StixExpr
+
+
+-- Helper fn to make Stix assignment statements where the
+-- lvalue masquerades as a StixExpr. A kludge that should
+-- be done away with.
+mkStAssign :: PrimRep -> StixExpr -> StixExpr -> StixStmt
+mkStAssign rep (StReg reg) rhs
+ = StAssignReg rep reg rhs
+mkStAssign rep (StInd rep' addr) rhs
+ | rep `isCloseEnoughTo` rep'
+ = StAssignMem rep addr rhs
+ | otherwise
+ = --pprPanic "Stix.mkStAssign: mismatched reps" (ppr rep <+> ppr rep')
+ --trace ("Stix.mkStAssign: mismatched reps: " ++ showSDoc (ppr rep <+> ppr rep')) (
+ StAssignMem rep addr rhs
+ --)
+ where
+ isCloseEnoughTo r1 r2
+ = r1 == r2 || (wordIsh r1 && wordIsh r2)
+ wordIsh rep
+ = rep `elem` [IntRep, WordRep, PtrRep, AddrRep, CodePtrRep, RetRep ]
+ -- determined by looking at PrimRep.showPrimRep
+
+-- Stix trees which denote a value.
+data StixExpr
+ = -- Literals
+ StInt Integer -- ** add Kind at some point
+ | StFloat Rational
+ | StDouble Rational
+ | StString FastString
+ | StCLbl CLabel -- labels that we might index into
+
+ -- Abstract registers of various kinds
+ | StReg StixReg
+
+ -- A typed offset from a base location
+ | StIndex PrimRep StixExpr StixExpr -- kind, base, offset
+
+ -- An indirection from an address to its contents.
+ | StInd PrimRep StixExpr
+
+ -- Primitive Operations
+ | StMachOp MachOp [StixExpr]
+
+ -- Calls to C functions
+ | StCall (Either FastString StixExpr) -- Left: static, Right: dynamic
+ CCallConv PrimRep [StixExpr]
+
+
+-- What's the PrimRep of the value denoted by this StixExpr?
+repOfStixExpr :: StixExpr -> PrimRep
+repOfStixExpr (StInt _) = IntRep
+repOfStixExpr (StFloat _) = FloatRep
+repOfStixExpr (StDouble _) = DoubleRep
+repOfStixExpr (StString _) = PtrRep
+repOfStixExpr (StCLbl _) = PtrRep
+repOfStixExpr (StReg reg) = repOfStixReg reg
+repOfStixExpr (StIndex _ _ _) = PtrRep
+repOfStixExpr (StInd rep _) = rep
+repOfStixExpr (StCall target conv retrep args) = retrep
+repOfStixExpr (StMachOp mop args) = resultRepOfMachOp mop
+
+
+-- used by insnFuture in RegAllocInfo.lhs
+data DestInfo
+ = NoDestInfo -- no supplied dests; infer from context
+ | DestInfo [CLabel] -- precisely these dests and no others
+
+hasDestInfo NoDestInfo = False
+hasDestInfo (DestInfo _) = True
+
+pprDests :: DestInfo -> SDoc
+pprDests NoDestInfo = text "NoDestInfo"
+pprDests (DestInfo dsts) = brackets (hsep (map pprCLabel dsts))
+
+
+pprStixStmts :: [StixStmt] -> SDoc
+pprStixStmts ts
+ = vcat [
+ vcat (map pprStixStmt ts),
+ char ' ',
+ char ' '
+ ]
+
+
+pprStixExpr :: StixExpr -> SDoc
+pprStixExpr t
+ = case t of
+ StCLbl lbl -> pprCLabel lbl
+ StInt i -> (if i < 0 then parens else id) (integer i)
+ StFloat rat -> parens (text "Float" <+> rational rat)
+ StDouble rat -> parens (text "Double" <+> rational rat)
+ StString str -> parens (text "Str `" <> ftext str <> char '\'')
+ StIndex k b o -> parens (pprStixExpr b <+> char '+' <>
+ ppr k <+> pprStixExpr o)
+ StInd k t -> ppr k <> char '[' <> pprStixExpr t <> char ']'
+ StReg reg -> pprStixReg reg
+ StMachOp op args -> pprMachOp op
+ <> parens (hsep (punctuate comma (map pprStixExpr args)))
+ StCall fn cc k args
+ -> parens (text "Call" <+> targ <+>
+ ppr cc <+> ppr k <+>
+ hsep (map pprStixExpr args))
+ where
+ targ = case fn of
+ Left t_static -> ftext t_static
+ Right t_dyn -> parens (pprStixExpr t_dyn)
+
+pprStixStmt :: StixStmt -> SDoc
+pprStixStmt t
+ = case t of
+ StSegment cseg -> parens (ppCodeSegment cseg)
+ StComment str -> parens (text "Comment" <+> ftext str)
+ StAssignReg pr reg rhs
+ -> pprStixReg reg <> text " :=" <> ppr pr
+ <> text " " <> pprStixExpr rhs
+ StAssignMem pr addr rhs
+ -> ppr pr <> char '[' <> pprStixExpr addr <> char ']'
+ <> text " :=" <> ppr pr
+ <> text " " <> pprStixExpr rhs
+ StLabel ll -> pprCLabel ll <+> char ':'
+ StFunBegin ll -> char ' ' $$ parens (text "FunBegin" <+> pprCLabel ll)
+ StFunEnd ll -> parens (text "FunEnd" <+> pprCLabel ll)
+ StJump dsts t -> parens (text "Jump" <+> pprDests dsts <+> pprStixExpr t)
+ StFallThrough ll -> parens (text "FallThru" <+> pprCLabel ll)
+ StCondJump l t -> parens (text "JumpC" <+> pprCLabel l
+ <+> pprStixExpr t)
+ StData k ds -> parens (text "Data" <+> ppr k <+>
+ hsep (map pprStixExpr ds))
+ StDataString str -> parens (text "DataString" <+> ppr str)
+ StVoidable expr -> text "(void)" <+> pprStixExpr expr
+\end{code}