X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FPprAbsC.lhs;h=64f8048986baeafdcde461aefb9d89246104c025;hb=70d68b088f9531ceb1ff6fa5cad1ee285f9c7187;hp=ce22e157e8877b480efc84f6c9bf0be1f649f5cc;hpb=49fe21121cf7532457b69e68d5cb17f73230b4e5;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index ce22e15..64f8048 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -253,32 +253,7 @@ pprAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs) _ -- NEW CASES FOR EXPANDED PRIMOPS --- We have to deal with some of these specially -pprAbsC (CMachOpStmt (Just res) (MO_ReadOSBI offw scaleRep) - [baseAmode, indexAmode] maybe_vols) - _ - | isNothing maybe_vols - = hcat [ -- text " /* ReadOSBI */ ", - ppr_amode res, equals, - ppr_array_expression offw scaleRep baseAmode indexAmode, - semi ] - | otherwise - = panic "pprAbsC:MO_ReadOSBI -- out-of-line array indexing ?!?!" - -pprAbsC (CMachOpStmt Nothing (MO_WriteOSBI offw scaleRep) - [baseAmode, indexAmode, vAmode] maybe_vols) - _ - | isNothing maybe_vols - = hcat [ -- text " /* WriteOSBI */ ", - ppr_array_expression offw scaleRep baseAmode indexAmode, - equals, pprAmode vAmode, - semi ] - | otherwise - = panic "pprAbsC:MO_WriteOSBI -- out-of-line array indexing ?!?!" - --- The rest generically. - -pprAbsC stmt@(CMachOpStmt (Just res) mop [arg1,arg2] maybe_vols) _ +pprAbsC stmt@(CMachOpStmt res mop [arg1,arg2] maybe_vols) _ = let prefix_fn = mop `elem` [MO_Dbl_Pwr, MO_Flt_Pwr, MO_NatS_MulMayOflo] in case ppr_maybe_vol_regs maybe_vols of {(saves,restores) -> @@ -293,7 +268,7 @@ pprAbsC stmt@(CMachOpStmt (Just res) mop [arg1,arg2] maybe_vols) _ $$ restores } -pprAbsC stmt@(CMachOpStmt (Just res) mop [arg1] maybe_vols) _ +pprAbsC stmt@(CMachOpStmt res mop [arg1] maybe_vols) _ = case ppr_maybe_vol_regs maybe_vols of {(saves,restores) -> saves $$ hcat [ppr_amode res, equals, @@ -754,24 +729,6 @@ pprMachOp_for_C MO_32U_to_NatU = text "(StgWord32)(StgWord)" pprMachOp_for_C MO_8U_to_32U = text "(StgWord32)" pprMachOp_for_C MO_32U_to_8U = text "(StgWord8)" -pprMachOp_for_C (MO_ReadOSBI _ _) = panic "pprMachOp_for_C:MO_ReadOSBI" -pprMachOp_for_C (MO_WriteOSBI _ _) = panic "pprMachOp_for_C:MO_WriteOSBI" - - --- Helper for printing array expressions. -ppr_array_expression offw scaleRep baseAmode indexAmode - -- create: - -- * (scaleRep*) ( - -- ((char*)baseAmode) + offw*bytes_per_word + indexAmode*bytes_per_scaleRep - -- ) - = let offb = parens (int offw <> char '*' <> text "sizeof(void*)") - indb = parens (parens (pprAmode indexAmode) - <> char '*' <> int (getPrimRepArrayElemSize scaleRep)) - baseb = text "(char*)" <> parens (pprAmode baseAmode) - addr = parens baseb <+> char '+' <+> offb <+> char '+' <+> indb - in - char '*' <> parens (ppr scaleRep <> char '*') <> parens addr - ppLocalness lbl = if (externallyVisibleCLabel lbl) @@ -1178,15 +1135,15 @@ Special treatment for floats and doubles, to avoid unwanted conversions. \begin{code} pprAssign FloatRep dest@(CVal reg_rel _) src - = hcat [ ptext SLIT("ASSIGN_FLT"),char '(', ppr_amode (CAddr reg_rel), comma, pprAmode src, pp_paren_semi ] + = hcat [ ptext SLIT("ASSIGN_FLT((W_*)"), parens (ppr_amode (CAddr reg_rel)), comma, pprAmode src, pp_paren_semi ] pprAssign DoubleRep dest@(CVal reg_rel _) src - = hcat [ ptext SLIT("ASSIGN_DBL"),char '(', ppr_amode (CAddr reg_rel), comma, pprAmode src, pp_paren_semi ] + = hcat [ ptext SLIT("ASSIGN_DBL((W_*)"), parens (ppr_amode (CAddr reg_rel)), comma, pprAmode src, pp_paren_semi ] pprAssign Int64Rep dest@(CVal reg_rel _) src - = hcat [ ptext SLIT("ASSIGN_Int64"),char '(', ppr_amode (CAddr reg_rel), comma, pprAmode src, pp_paren_semi ] + = hcat [ ptext SLIT("ASSIGN_Int64((W_*)"), parens (ppr_amode (CAddr reg_rel)), comma, pprAmode src, pp_paren_semi ] pprAssign Word64Rep dest@(CVal reg_rel _) src - = hcat [ ptext SLIT("ASSIGN_Word64"),char '(', ppr_amode (CAddr reg_rel), comma, pprAmode src, pp_paren_semi ] + = hcat [ ptext SLIT("ASSIGN_Word64((W_*)"), parens (ppr_amode (CAddr reg_rel)), comma, pprAmode src, pp_paren_semi ] \end{code} Lastly, the question is: will the C compiler think the types of the @@ -1255,13 +1212,13 @@ question.) \begin{code} pprAmode (CVal reg_rel FloatRep) - = hcat [ text "PK_FLT(", ppr_amode (CAddr reg_rel), rparen ] + = hcat [ text "PK_FLT((W_*)", parens (ppr_amode (CAddr reg_rel)), rparen ] pprAmode (CVal reg_rel DoubleRep) - = hcat [ text "PK_DBL(", ppr_amode (CAddr reg_rel), rparen ] + = hcat [ text "PK_DBL((W_*)", parens (ppr_amode (CAddr reg_rel)), rparen ] pprAmode (CVal reg_rel Int64Rep) - = hcat [ text "PK_Int64(", ppr_amode (CAddr reg_rel), rparen ] + = hcat [ text "PK_Int64((W_*)", parens (ppr_amode (CAddr reg_rel)), rparen ] pprAmode (CVal reg_rel Word64Rep) - = hcat [ text "PK_Word64(", ppr_amode (CAddr reg_rel), rparen ] + = hcat [ text "PK_Word64((W_*)", parens (ppr_amode (CAddr reg_rel)), rparen ] \end{code} Next comes the case where there is some other cast need, and the @@ -1294,10 +1251,6 @@ amode has kind2. ppr_amode CBytesPerWord = text "(sizeof(void*))" -ppr_amode (CMem rep addr) - = let txt_rep = pprPrimKind rep - in hcat [ char '*', parens (txt_rep <> char '*'), parens (ppr_amode addr) ] - ppr_amode (CVal reg_rel@(CIndex _ _ _) kind) = case (pprRegRelative False{-no sign wanted-} reg_rel) of (pp_reg, Nothing) -> panic "ppr_amode: CIndex" @@ -1701,7 +1654,7 @@ ppr_decls_AbsC (CInitHdr cl_info reg_rel cost_centre _) where info_lbl = infoTableLabelFromCI cl_info -ppr_decls_AbsC (CMachOpStmt res _ args _) = ppr_decls_Amodes (maybeToList res ++ args) +ppr_decls_AbsC (CMachOpStmt res _ args _) = ppr_decls_Amodes (res : args) ppr_decls_AbsC (COpStmt results _ args _) = ppr_decls_Amodes (results ++ args) ppr_decls_AbsC (CSimultaneous abc) = ppr_decls_AbsC abc