--------------------------------------------------------------------------------- (c) The University of Glasgow 2004-2006---- CmmLint: checking the correctness of Cmm statements and expressions-------------------------------------------------------------------------------{-# OPTIONS -fno-warn-tabs #-}-- The above warning supression flag is a temporary kludge.-- While working on this module you are encouraged to remove it and-- detab the module (please do the detabbing in a separate patch). See-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces-- for detailsmoduleOldCmmLint(cmmLint,cmmLintTop)whereimportBlockIdimportOldCmmimportCLabelimportOutputableimportOldPprCmm()importConstantsimportFastStringimportPlatformimportData.Maybe-- ------------------------------------------------------------------------------- Exported entry points:cmmLint::(Outputabled,Outputableh)=>Platform->GenCmmGroupdh(ListGraphCmmStmt)->MaybeSDoccmmLintplatformtops=runCmmLintplatform(mapM_(lintCmmDeclplatform))topscmmLintTop::(Outputabled,Outputableh)=>Platform->GenCmmDecldh(ListGraphCmmStmt)->MaybeSDoccmmLintTopplatformtop=runCmmLintplatform(lintCmmDeclplatform)toprunCmmLint::Outputablea=>Platform->(a->CmmLintb)->a->MaybeSDocrunCmmLint_lp=caseunCL(lp)ofLefterr->Just(vcat[ptext$sLit("Cmm lint error:"),nest2err,ptext$sLit("Program was:"),nest2(pprp)])Right_->NothinglintCmmDecl::Platform->(GenCmmDeclhi(ListGraphCmmStmt))->CmmLint()lintCmmDeclplatform(CmmProc_lbl(ListGraphblocks))=addLintInfo(text"in proc "<>pprCLabelplatformlbl)$letlabels=foldl(\sb->setInsert(blockIdb)s)setEmptyblocksinmapM_(lintCmmBlockplatformlabels)blockslintCmmDecl_(CmmData{})=return()lintCmmBlock::Platform->BlockSet->GenBasicBlockCmmStmt->CmmLint()lintCmmBlockplatformlabels(BasicBlockidstmts)=addLintInfo(text"in basic block "<>pprid)$mapM_(lintCmmStmtplatformlabels)stmts-- ------------------------------------------------------------------------------- lintCmmExpr-- Checks whether a CmmExpr is "type-correct", and check for obvious-looking-- byte/word mismatches.lintCmmExpr::Platform->CmmExpr->CmmLintCmmTypelintCmmExprplatform(CmmLoadexprrep)=do_<-lintCmmExprplatformexpr-- Disabled, if we have the inlining phase before the lint phase,-- we can have funny offsets due to pointer tagging. -- EZY-- when (widthInBytes (typeWidth rep) >= wORD_SIZE) $-- cmmCheckWordAddress exprreturnreplintCmmExprplatformexpr@(CmmMachOpopargs)=dotys<-mapM(lintCmmExprplatform)argsifmap(typeWidth.cmmExprType)args==machOpArgRepsopthencmmCheckMachOpopargstyselsecmmLintMachOpErrexpr(mapcmmExprTypeargs)(machOpArgRepsop)lintCmmExprplatform(CmmRegOffregoffset)=lintCmmExprplatform(CmmMachOp(MO_Addrep)[CmmRegreg,CmmLit(CmmInt(fromIntegraloffset)rep)])whererep=typeWidth(cmmRegTypereg)lintCmmExpr_expr=return(cmmExprTypeexpr)-- Check for some common byte/word mismatches (eg. Sp + 1)cmmCheckMachOp::MachOp->[CmmExpr]->[CmmType]->CmmLintCmmTypecmmCheckMachOpop[lit@(CmmLit(CmmInt{})),reg@(CmmReg_)]tys=cmmCheckMachOpop[reg,lit]tyscmmCheckMachOpop_tys=return(machOpResultTypeoptys)isOffsetOp::MachOp->BoolisOffsetOp(MO_Add_)=TrueisOffsetOp(MO_Sub_)=TrueisOffsetOp_=False-- This expression should be an address from which a word can be loaded:-- check for funny-looking sub-word offsets._cmmCheckWordAddress::CmmExpr->CmmLint()_cmmCheckWordAddresse@(CmmMachOpop[arg,CmmLit(CmmInti_)])|isOffsetOpop&&notNodeRegarg&&i`rem`fromIntegralwORD_SIZE/=0=cmmLintDubiousWordOffsete_cmmCheckWordAddresse@(CmmMachOpop[CmmLit(CmmInti_),arg])|isOffsetOpop&&notNodeRegarg&&i`rem`fromIntegralwORD_SIZE/=0=cmmLintDubiousWordOffsete_cmmCheckWordAddress_=return()-- No warnings for unaligned arithmetic with the node register,-- which is used to extract fields from tagged constructor closures.notNodeReg::CmmExpr->BoolnotNodeReg(CmmRegreg)|reg==nodeReg=FalsenotNodeReg_=TruelintCmmStmt::Platform->BlockSet->CmmStmt->CmmLint()lintCmmStmtplatformlabels=lintwherelint(CmmNop)=return()lint(CmmComment{})=return()lintstmt@(CmmAssignregexpr)=doerep<-lintCmmExprplatformexprletreg_ty=cmmRegTyperegif(erep`cmmEqType_ignoring_ptrhood`reg_ty)thenreturn()elsecmmLintAssignErrstmterepreg_tylint(CmmStorelr)=do_<-lintCmmExprplatforml_<-lintCmmExprplatformrreturn()lint(CmmCalltarget_resargs_)=dolintTargetplatformlabelstargetmapM_(lintCmmExprplatform.hintlessCmm)argslint(CmmCondBrancheid)=checkTargetid>>lintCmmExprplatforme>>checkCondelint(CmmSwitchebranches)=domapM_checkTarget$catMaybesbrancheserep<-lintCmmExprplatformeif(erep`cmmEqType_ignoring_ptrhood`bWord)thenreturn()elsecmmLintErr(text"switch scrutinee is not a word: "<>ppre<>text" :: "<>pprerep)lint(CmmJumpe_)=lintCmmExprplatforme>>return()lint(CmmReturn)=return()lint(CmmBranchid)=checkTargetidcheckTargetid=ifsetMemberidlabelsthenreturn()elsecmmLintErr(text"Branch to nonexistent id"<+>pprid)lintTarget::Platform->BlockSet->CmmCallTarget->CmmLint()lintTargetplatform_(CmmCalleee_)=do_<-lintCmmExprplatformereturn()lintTarget__(CmmPrim_Nothing)=return()lintTargetplatformlabels(CmmPrim_(Juststmts))=mapM_(lintCmmStmtplatformlabels)stmtscheckCond::CmmExpr->CmmLint()checkCond(CmmMachOpmop_)|isComparisonMachOpmop=return()checkCond(CmmLit(CmmIntxt))|x==0||x==1,t==wordWidth=return()-- constant valuescheckCondexpr=cmmLintErr(hang(text"expression is not a conditional:")2(pprexpr))-- ------------------------------------------------------------------------------- CmmLint monad-- just a basic error monad:newtypeCmmLinta=CmmLint{unCL::EitherSDoca}instanceMonadCmmLintwhereCmmLintm>>=k=CmmLint$casemofLefte->LefteRighta->unCL(ka)returna=CmmLint(Righta)cmmLintErr::SDoc->CmmLintacmmLintErrmsg=CmmLint(Leftmsg)addLintInfo::SDoc->CmmLinta->CmmLintaaddLintInfoinfothing=CmmLint$caseunCLthingofLefterr->Left(hanginfo2err)Righta->RightacmmLintMachOpErr::CmmExpr->[CmmType]->[Width]->CmmLintacmmLintMachOpErrexprargsRepopExpectsRep=cmmLintErr(text"in MachOp application: "$$nest2(pprexpr)$$(text"op is expecting: "<+>ppropExpectsRep)$$(text"arguments provide: "<+>pprargsRep))cmmLintAssignErr::CmmStmt->CmmType->CmmType->CmmLintacmmLintAssignErrstmte_tyr_ty=cmmLintErr(text"in assignment: "$$nest2(vcat[pprstmt,text"Reg ty:"<+>pprr_ty,text"Rhs ty:"<+>ppre_ty]))cmmLintDubiousWordOffset::CmmExpr->CmmLintacmmLintDubiousWordOffsetexpr=cmmLintErr(text"offset is not a multiple of words: "$$nest2(pprexpr))