X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FPpr.hs;h=4c3454d43b9dcda4ab69b059e1081091585a9b2e;hb=81ca050634c59d6b9a42a6bdc8224902f20ec542;hp=7944a38ff4f7c6eb430d66d3b285e73fac1bb36f;hpb=889c084e943779e76d19f2ef5e970ff655f511eb;p=ghc-hetmet.git diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 7944a38..4c3454d 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -87,7 +87,17 @@ pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) = <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl) else empty #endif + $$ pprSizeDecl (if null info then lbl else entryLblToInfoLbl lbl) +-- | Output the ELF .size directive. +pprSizeDecl :: CLabel -> Doc +#if elf_OBJ_FORMAT +pprSizeDecl lbl = + ptext (sLit "\t.size") <+> pprCLabel_asm lbl + <> ptext (sLit ", .-") <> pprCLabel_asm lbl +#else +pprSizeDecl _ = empty +#endif pprBasicBlock :: NatBasicBlock Instr -> Doc pprBasicBlock (BasicBlock blockid instrs) = @@ -626,7 +636,7 @@ pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm) pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm) pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand archWordSize op) -pprInstr (JMP_TBL op _) = pprInstr (JMP op) +pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op) pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm) pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg) @@ -720,6 +730,11 @@ pprInstr g@(GITOD src dst) text " ; fildl (%esp) ; ", gpop dst 1, text " ; addl $4,%esp"]) +pprInstr g@(GDTOF src dst) + = pprG g (vcat [gtab <> gpush src 0, + gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;", + gtab <> gpop dst 1]) + {- Gruesome swamp follows. If you're unfortunate enough to have ventured this far into the jungle AND you give a Rat's Ass (tm) what's going on, here's the deal. Generate code to do a floating point comparison @@ -975,6 +990,7 @@ pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst +pprGInstr (GDTOF src dst) = pprSizeSizeRegReg (sLit "gdtof") FF64 FF32 src dst pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst