{-# OPTIONS -fno-warn-type-defaults #-}-- ------------------------------------------------------------------------------ | Handle conversion of CmmProc to LLVM code.--moduleLlvmCodeGen.CodeGen(genLlvmProc)where#include "HsVersions.h"importLlvmimportLlvmCodeGen.BaseimportLlvmCodeGen.RegsimportBlockIdimportCgUtils(activeStgRegs,callerSaves)importCLabelimportOldCmmimportqualifiedOldPprCmmasPprCmmimportDynFlagsimportFastStringimportForeignCallimportOutputablehiding(panic,pprPanic)importqualifiedOutputableimportPlatformimportOrdListimportUniqSupplyimportUniqueimportUtilimportData.List(partition)typeLlvmStatements=OrdListLlvmStatement-- ------------------------------------------------------------------------------- | Top-level of the LLVM proc Code generator--genLlvmProc::LlvmEnv->RawCmmDecl->UniqSM(LlvmEnv,[LlvmCmmDecl])genLlvmProcenv(CmmProcinfolbl(ListGraphblocks))=do(env',lmblocks,lmdata)<-basicBlocksCodeGenenvblocks([],[])letproc=CmmProcinfolbl(ListGraphlmblocks)return(env',proc:lmdata)genLlvmProc__=panic"genLlvmProc: case that shouldn't reach here!"-- ------------------------------------------------------------------------------- * Block code generation---- | Generate code for a list of blocks that make up a complete procedure.basicBlocksCodeGen::LlvmEnv->[CmmBasicBlock]->([LlvmBasicBlock],[LlvmCmmDecl])->UniqSM(LlvmEnv,[LlvmBasicBlock],[LlvmCmmDecl])basicBlocksCodeGenenv([])(blocks,tops)=dolet(blocks',allocs)=mapAndUnzipdominateAllocsblocksletallocs'=concatallocslet((BasicBlockidfstmts):rblks)=blocks'letfblocks=(BasicBlockid$funPrologue++allocs'++fstmts):rblksreturn(env,fblocks,tops)basicBlocksCodeGenenv(block:blocks)(lblocks',ltops')=do(env',lb,lt)<-basicBlockCodeGenenvblockletlblocks=lblocks'++lbletltops=ltops'++ltbasicBlocksCodeGenenv'blocks(lblocks,ltops)-- | Allocations need to be extracted so they can be moved to the entry-- of a function to make sure they dominate all possible paths in the CFG.dominateAllocs::LlvmBasicBlock->(LlvmBasicBlock,[LlvmStatement])dominateAllocs(BasicBlockidstmts)=let(allocs,stmts')=partitionisAllocstmtsisAlloc(Assignment_(Alloca__))=TrueisAlloc_other=Falsein(BasicBlockidstmts',allocs)-- | Generate code for one blockbasicBlockCodeGen::LlvmEnv->CmmBasicBlock->UniqSM(LlvmEnv,[LlvmBasicBlock],[LlvmCmmDecl])basicBlockCodeGenenv(BasicBlockidstmts)=do(env',instrs,top)<-stmtsToInstrsenvstmts(nilOL,[])return(env',[BasicBlockid(fromOLinstrs)],top)-- ------------------------------------------------------------------------------- * CmmStmt code generation---- A statement conversion return data.-- * LlvmEnv: The new environment-- * LlvmStatements: The compiled LLVM statements.-- * LlvmCmmDecl: Any global data needed.typeStmtData=(LlvmEnv,LlvmStatements,[LlvmCmmDecl])-- | Convert a list of CmmStmt's to LlvmStatement'sstmtsToInstrs::LlvmEnv->[CmmStmt]->(LlvmStatements,[LlvmCmmDecl])->UniqSMStmtDatastmtsToInstrsenv[](llvm,top)=return(env,llvm,top)stmtsToInstrsenv(stmt:stmts)(llvm,top)=do(env',instrs,tops)<-stmtToInstrsenvstmtstmtsToInstrsenv'stmts(llvm`appOL`instrs,top++tops)-- | Convert a CmmStmt to a list of LlvmStatement'sstmtToInstrs::LlvmEnv->CmmStmt->UniqSMStmtDatastmtToInstrsenvstmt=casestmtofCmmNop->return(env,nilOL,[])CmmComment_->return(env,nilOL,[])-- nuke commentsCmmAssignregsrc->genAssignenvregsrcCmmStoreaddrsrc->genStoreenvaddrsrcCmmBranchid->genBranchenvidCmmCondBranchargid->genCondBranchenvargidCmmSwitchargids->genSwitchenvargids-- Foreign CallCmmCalltargetresargsret->genCallenvtargetresargsret-- Tail callCmmJumparglive->genJumpenvarglive-- CPS, only tail calls, no return's-- Actually, there are a few return statements that occur because of hand-- written Cmm code.CmmReturn->return(env,unitOL$ReturnNothing,[])-- | Memory barrier instruction for LLVM >= 3.0barrier::LlvmEnv->UniqSMStmtDatabarrierenv=dolets=FenceFalseSyncSeqCstreturn(env,unitOLs,[])-- | Memory barrier instruction for LLVM < 3.0oldBarrier::LlvmEnv->UniqSMStmtDataoldBarrierenv=doletfname=fsLit"llvm.memory.barrier"letfunSig=LlvmFunctionDeclfnameExternallyVisibleCC_CccLMVoidFixedArgs(tysToParams[i1,i1,i1,i1,i1])llvmFunAlignletfty=LMFunctionfunSigletfv=LMGlobalVarfnamefty(funcLinkagefunSig)NothingNothingFalselettops=casefunLookupfnameenvofJust_->[]Nothing->[CmmDataData[([],[fty])]]letargs=[lmTrue,lmTrue,lmTrue,lmTrue,lmTrue]lets1=Expr$CallStdCallfvargsllvmStdFunAttrsletenv'=funInsertfnameftyenvreturn(env',unitOLs1,tops)wherelmTrue::LlvmVarlmTrue=mkIntLiti1(-1)-- | Foreign CallsgenCall::LlvmEnv->CmmCallTarget->[HintedCmmFormal]->[HintedCmmActual]->CmmReturnInfo->UniqSMStmtData-- Write barrier needs to be handled specially as it is implemented as an LLVM-- intrinsic function.genCallenv(CmmPrimMO_WriteBarrier_)___|platformArch(getLlvmPlatformenv)`elem`[ArchX86,ArchX86_64,ArchSPARC]=return(env,nilOL,[])|getLlvmVerenv>29=barrierenv|otherwise=oldBarrierenv-- Handle popcnt function specifically since GHC only really has i32 and i64-- types and things like Word8 are backed by an i32 and just present a logical-- i8 range. So we must handle conversions from i32 to i8 explicitly as LLVM-- is strict about types.genCallenvt@(CmmPrim(MO_PopCntw)_)[CmmHinteddst_]args_=doletwidth=widthToLlvmIntwdstTy=cmmToLlvmType$localRegTypedstfunTy=\n->LMFunction$LlvmFunctionDeclnExternallyVisibleCC_CccwidthFixedArgs(tysToParams[width])Nothing(env1,dstV,stmts1,top1)=getCmmRegenv(CmmLocaldst)(env2,argsV,stmts2,top2)<-arg_varsenv1args([],nilOL,[])(env3,fptr,stmts3,top3)<-getFunPtrenv2funTyt(argsV',stmts4)<-castVars$zipargsV[width](retV,s1)<-doExprwidth$CallStdCallfptrargsV'[]([retV'],stmts5)<-castVars[(retV,dstTy)]lets2=StoreretV'dstVletstmts=stmts1`appOL`stmts2`appOL`stmts3`appOL`stmts4`snocOL`s1`appOL`stmts5`snocOL`s2return(env3,stmts,top1++top2++top3)-- Handle memcpy function specifically since llvm's intrinsic version takes-- some extra parameters.genCallenvt@(CmmPrimop_)[]args'CmmMayReturn|op==MO_Memcpy||op==MO_Memset||op==MO_Memmove=dolet(args,alignVal)=splitAlignValargs'(isVolTy,isVolVal)=ifgetLlvmVerenv>=28then([i1],[mkIntLiti10])else([],[])argTy|op==MO_Memset=[i8Ptr,i8,llvmWord,i32]++isVolTy|otherwise=[i8Ptr,i8Ptr,llvmWord,i32]++isVolTyfunTy=\name->LMFunction$LlvmFunctionDeclnameExternallyVisibleCC_CccLMVoidFixedArgs(tysToParamsargTy)Nothing(env1,argVars,stmts1,top1)<-arg_varsenvargs([],nilOL,[])(env2,fptr,stmts2,top2)<-getFunPtrenv1funTyt(argVars',stmts3)<-castVars$zipargVarsargTyletarguments=argVars'++(alignVal:isVolVal)call=Expr$CallStdCallfptrarguments[]stmts=stmts1`appOL`stmts2`appOL`stmts3`appOL`trashStmts`snocOL`callreturn(env2,stmts,top1++top2)wheresplitAlignValxs=(initxs,extractLit$lastxs)-- Fix for trac #6158. Since LLVM 3.1, opt fails when given anything other-- than a direct constant (i.e. 'i32 8') as the alignment argument for the-- memcpy & co llvm intrinsic functions. So we handle this directly now.extractLit(CmmHinted(CmmLit(CmmInti_))_)=mkIntLiti32iextractLit_other=trace("WARNING: Non constant alignment value given"++" for memcpy! Please report to GHC developers")mkIntLiti320genCallenv(CmmPrim_(Juststmts))___=stmtsToInstrsenvstmts(nilOL,[])-- Handle all other foreign calls and prim ops.genCallenvtargetresargsret=do-- parameter typesletarg_type(CmmHinted_AddrHint)=i8Ptr-- cast pointers to i8*. Llvm equivalent of void*arg_type(CmmHintedexpr_)=cmmToLlvmType$cmmExprTypeexpr-- ret typeletret_type([])=LMVoidret_type([CmmHinted_AddrHint])=i8Ptrret_type([CmmHintedreg_])=cmmToLlvmType$localRegTyperegret_typet=panic$"genCall: Too many return values! Can only handle"++" 0 or 1, given "++show(lengtht)++"."-- extract Cmm call conventionletcconv=casetargetofCmmCallee_conv->convCmmPrim__->PrimCallConv-- translate to LLVM call conventionletlmconv=casecconvofStdCallConv->caseplatformArch(getLlvmPlatformenv)ofArchX86->CC_X86_StdccArchX86_64->CC_X86_Stdcc_->CC_CccCCallConv->CC_CccCApiConv->CC_CccPrimCallConv->CC_CccCmmCallConv->panic"CmmCallConv not supported here!"{-
Some of the possibilities here are a worry with the use of a custom
calling convention for passing STG args. In practice the more
dangerous combinations (e.g StdCall + llvmGhcCC) don't occur.
The native code generator only handles StdCall and CCallConv.
-}-- call attributesletfnAttrs|ret==CmmNeverReturns=NoReturn:llvmStdFunAttrs|otherwise=llvmStdFunAttrs-- fun typeletccTy=StdCall-- tail calls should be done through CmmJumpletretTy=ret_typeresletargTy=tysToParams$maparg_typeargsletfunTy=\name->LMFunction$LlvmFunctionDeclnameExternallyVisiblelmconvretTyFixedArgsargTyllvmFunAlign(env1,argVars,stmts1,top1)<-arg_varsenvargs([],nilOL,[])(env2,fptr,stmts2,top2)<-getFunPtrenv1funTytargetletretStmt|ccTy==TailCall=unitOL$ReturnNothing|ret==CmmNeverReturns=unitOL$Unreachable|otherwise=nilOLletstmts=stmts1`appOL`stmts2`appOL`trashStmts-- make the actual callcaseretTyofLMVoid->dolets1=Expr$CallccTyfptrargVarsfnAttrsletallStmts=stmts`snocOL`s1`appOL`retStmtreturn(env2,allStmts,top1++top2)_->do(v1,s1)<-doExprretTy$CallccTyfptrargVarsfnAttrs-- get the return registerletret_reg([CmmHintedreghint])=(reg,hint)ret_regt=panic$"genCall: Bad number of registers! Can only handle"++" 1, given "++show(lengtht)++"."let(creg,_)=ret_regreslet(env3,vreg,stmts3,top3)=getCmmRegenv2(CmmLocalcreg)letallStmts=stmts`snocOL`s1`appOL`stmts3ifretTy==pLower(getVarTypevreg)thendolets2=Storev1vregreturn(env3,allStmts`snocOL`s2`appOL`retStmt,top1++top2++top3)elsedoletty=pLower$getVarTypevregletop=casetyofvt|isPointervt->LM_Bitcast|isIntvt->LM_Ptrtoint|otherwise->panic$"genCall: CmmReg bad match for"++" returned type!"(v2,s2)<-doExprty$Castopv1tylets3=Storev2vregreturn(env3,allStmts`snocOL`s2`snocOL`s3`appOL`retStmt,top1++top2++top3)-- | Create a function pointer from a target.getFunPtr::LlvmEnv->(LMString->LlvmType)->CmmCallTarget->UniqSMExprDatagetFunPtrenvfunTytarg=casetargofCmmCallee(CmmLit(CmmLabellbl))_->litCase$strCLabel_llvmenvlblCmmCalleeexpr_->do(env',v1,stmts,top)<-exprToVarenvexprletfty=funTy$fsLit"dynamic"cast=casegetVarTypev1ofty|isPointerty->LM_Bitcastty|isIntty->LM_Inttoptrty->panic$"genCall: Expr is of bad type for function"++" call! ("++show(ty)++")"(v2,s1)<-doExpr(pLiftfty)$Castcastv1(pLiftfty)return(env',v2,stmts`snocOL`s1,top)CmmPrimmop_->litCase$cmmPrimOpFunctionsenvmopwherelitCasename=docasefunLookupnameenvofJustty'@(LMFunctionsig)->do-- Function in module in right formletfun=LMGlobalVarnamety'(funcLinkagesig)NothingNothingFalsereturn(env,fun,nilOL,[])Justty'->do-- label in module but not function pointer, convertletfty@(LMFunctionsig)=funTynamefun=LMGlobalVarname(pLiftty')(funcLinkagesig)NothingNothingFalse(v1,s1)<-doExpr(pLiftfty)$CastLM_Bitcastfun(pLiftfty)return(env,v1,unitOLs1,[])Nothing->do-- label not in module, create external referenceletfty@(LMFunctionsig)=funTynamefun=LMGlobalVarnamefty(funcLinkagesig)NothingNothingFalsetop=[CmmDataData[([],[fty])]]env'=funInsertnameftyenvreturn(env',fun,nilOL,top)-- | Conversion of call arguments.arg_vars::LlvmEnv->[HintedCmmActual]->([LlvmVar],LlvmStatements,[LlvmCmmDecl])->UniqSM(LlvmEnv,[LlvmVar],LlvmStatements,[LlvmCmmDecl])arg_varsenv[](vars,stmts,tops)=return(env,vars,stmts,tops)arg_varsenv(CmmHintedeAddrHint:rest)(vars,stmts,tops)=do(env',v1,stmts',top')<-exprToVarenveletop=casegetVarTypev1ofty|isPointerty->LM_Bitcastty|isIntty->LM_Inttoptra->panic$"genCall: Can't cast llvmType to i8*! ("++showa++")"(v2,s1)<-doExpri8Ptr$Castopv1i8Ptrarg_varsenv'rest(vars++[v2],stmts`appOL`stmts'`snocOL`s1,tops++top')arg_varsenv(CmmHintede_:rest)(vars,stmts,tops)=do(env',v1,stmts',top')<-exprToVarenvearg_varsenv'rest(vars++[v1],stmts`appOL`stmts',tops++top')-- | Cast a collection of LLVM variables to specific types.castVars::[(LlvmVar,LlvmType)]->UniqSM([LlvmVar],LlvmStatements)castVarsvars=dodone<-mapM(uncurrycastVar)varslet(vars',stmts)=unzipdonereturn(vars',toOLstmts)-- | Cast an LLVM variable to a specific type, panicing if it can't be done.castVar::LlvmVar->LlvmType->UniqSM(LlvmVar,LlvmStatement)castVarvt|getVarTypev==t=return(v,Nop)|otherwise=letop=case(getVarTypev,t)of(LMIntn,LMIntm)->ifn<mthenLM_SextelseLM_Trunc(vt,_)|isFloatvt&&isFloatt->ifllvmWidthInBitsvt<llvmWidthInBitstthenLM_FpextelseLM_Fptrunc(vt,_)|isIntvt&&isFloatt->LM_Sitofp(vt,_)|isFloatvt&&isIntt->LM_Fptosi(vt,_)|isIntvt&&isPointert->LM_Inttoptr(vt,_)|isPointervt&&isIntt->LM_Ptrtoint(vt,_)|isPointervt&&isPointert->LM_Bitcast(vt,_)->panic$"castVars: Can't cast this type ("++showvt++") to ("++showt++")"indoExprt$Castopvt-- | Decide what C function to use to implement a CallishMachOpcmmPrimOpFunctions::LlvmEnv->CallishMachOp->LMStringcmmPrimOpFunctionsenvmop=casemopofMO_F32_Exp->fsLit"expf"MO_F32_Log->fsLit"logf"MO_F32_Sqrt->fsLit"llvm.sqrt.f32"MO_F32_Pwr->fsLit"llvm.pow.f32"MO_F32_Sin->fsLit"llvm.sin.f32"MO_F32_Cos->fsLit"llvm.cos.f32"MO_F32_Tan->fsLit"tanf"MO_F32_Asin->fsLit"asinf"MO_F32_Acos->fsLit"acosf"MO_F32_Atan->fsLit"atanf"MO_F32_Sinh->fsLit"sinhf"MO_F32_Cosh->fsLit"coshf"MO_F32_Tanh->fsLit"tanhf"MO_F64_Exp->fsLit"exp"MO_F64_Log->fsLit"log"MO_F64_Sqrt->fsLit"llvm.sqrt.f64"MO_F64_Pwr->fsLit"llvm.pow.f64"MO_F64_Sin->fsLit"llvm.sin.f64"MO_F64_Cos->fsLit"llvm.cos.f64"MO_F64_Tan->fsLit"tan"MO_F64_Asin->fsLit"asin"MO_F64_Acos->fsLit"acos"MO_F64_Atan->fsLit"atan"MO_F64_Sinh->fsLit"sinh"MO_F64_Cosh->fsLit"cosh"MO_F64_Tanh->fsLit"tanh"MO_Memcpy->fsLit$"llvm.memcpy."++intrinTy1MO_Memmove->fsLit$"llvm.memmove."++intrinTy1MO_Memset->fsLit$"llvm.memset."++intrinTy2(MO_PopCntw)->fsLit$"llvm.ctpop."++show(widthToLlvmIntw)MO_S_QuotRem{}->unsupportedMO_U_QuotRem{}->unsupportedMO_U_QuotRem2{}->unsupportedMO_Add2{}->unsupportedMO_U_Mul2{}->unsupportedMO_WriteBarrier->unsupportedMO_Touch->unsupportedwhereintrinTy1=(ifgetLlvmVerenv>=28then"p0i8.p0i8."else"")++showllvmWordintrinTy2=(ifgetLlvmVerenv>=28then"p0i8."else"")++showllvmWordunsupported=panic("cmmPrimOpFunctions: "++showmop++" not supported here")-- | Tail function callsgenJump::LlvmEnv->CmmExpr->Maybe[GlobalReg]->UniqSMStmtData-- Call to known functiongenJumpenv(CmmLit(CmmLabellbl))live=do(env',vf,stmts,top)<-getHsFuncenvlbl(stgRegs,stgStmts)<-funEpilogueenvlivelets1=Expr$CallTailCallvfstgRegsllvmStdFunAttrslets2=ReturnNothingreturn(env',stmts`appOL`stgStmts`snocOL`s1`snocOL`s2,top)-- Call to unknown function / addressgenJumpenvexprlive=doletfty=llvmFunTy(env',vf,stmts,top)<-exprToVarenvexprletcast=casegetVarTypevfofty|isPointerty->LM_Bitcastty|isIntty->LM_Inttoptrty->panic$"genJump: Expr is of bad type for function call! ("++show(ty)++")"(v1,s1)<-doExpr(pLiftfty)$Castcastvf(pLiftfty)(stgRegs,stgStmts)<-funEpilogueenvlivelets2=Expr$CallTailCallv1stgRegsllvmStdFunAttrslets3=ReturnNothingreturn(env',stmts`snocOL`s1`appOL`stgStmts`snocOL`s2`snocOL`s3,top)-- | CmmAssign operation---- We use stack allocated variables for CmmReg. The optimiser will replace-- these with registers when possible.genAssign::LlvmEnv->CmmReg->CmmExpr->UniqSMStmtDatagenAssignenvregval=dolet(env1,vreg,stmts1,top1)=getCmmRegenvreg(env2,vval,stmts2,top2)<-exprToVarenv1valletstmts=stmts1`appOL`stmts2letty=(pLower.getVarType)vregcaseisPointerty&&getVarTypevval==llvmWordof-- Some registers are pointer types, so need to cast value to pointerTrue->do(v,s1)<-doExprty$CastLM_Inttoptrvvaltylets2=Storevvregreturn(env2,stmts`snocOL`s1`snocOL`s2,top1++top2)False->dolets1=Storevvalvregreturn(env2,stmts`snocOL`s1,top1++top2)-- | CmmStore operationgenStore::LlvmEnv->CmmExpr->CmmExpr->UniqSMStmtData-- First we try to detect a few common cases and produce better code for-- these then the default case. We are mostly trying to detect Cmm code-- like I32[Sp + n] and use 'getelementptr' operations instead of the-- generic case that uses casts and pointer arithmeticgenStoreenvaddr@(CmmReg(CmmGlobalr))val=genStore_fastenvaddrr0valgenStoreenvaddr@(CmmRegOff(CmmGlobalr)n)val=genStore_fastenvaddrrnvalgenStoreenvaddr@(CmmMachOp(MO_Add_)[(CmmReg(CmmGlobalr)),(CmmLit(CmmIntn_))])val=genStore_fastenvaddrr(fromIntegern)valgenStoreenvaddr@(CmmMachOp(MO_Sub_)[(CmmReg(CmmGlobalr)),(CmmLit(CmmIntn_))])val=genStore_fastenvaddrr(negate$fromIntegern)val-- generic casegenStoreenvaddrval=genStore_slowenvaddrval[other]-- | CmmStore operation-- This is a special case for storing to a global register pointer-- offset such as I32[Sp+8].genStore_fast::LlvmEnv->CmmExpr->GlobalReg->Int->CmmExpr->UniqSMStmtDatagenStore_fastenvaddrrnval=letgr=lmGlobalRegVarrmeta=[getTBAAr]grt=(pLower.getVarType)gr(ix,rem)=n`divMod`((llvmWidthInBits.pLower)grt`div`8)incaseisPointergrt&&rem==0ofTrue->do(env',vval,stmts,top)<-exprToVarenvval(gv,s1)<-doExprgrt$Loadgr(ptr,s2)<-doExprgrt$GetElemPtrTruegv[toI32ix]-- We might need a different pointer type, so checkcasepLowergrt==getVarTypevvalof-- were fineTrue->dolets3=MetaStmtmeta$Storevvalptrreturn(env',stmts`snocOL`s1`snocOL`s2`snocOL`s3,top)-- cast to pointer type neededFalse->doletty=(pLift.getVarType)vval(ptr',s3)<-doExprty$CastLM_Bitcastptrtylets4=MetaStmtmeta$Storevvalptr'return(env',stmts`snocOL`s1`snocOL`s2`snocOL`s3`snocOL`s4,top)-- If its a bit type then we use the slow method since-- we can't avoid casting anyway.False->genStore_slowenvaddrvalmeta-- | CmmStore operation-- Generic case. Uses casts and pointer arithmetic if needed.genStore_slow::LlvmEnv->CmmExpr->CmmExpr->[MetaData]->UniqSMStmtDatagenStore_slowenvaddrvalmeta=do(env1,vaddr,stmts1,top1)<-exprToVarenvaddr(env2,vval,stmts2,top2)<-exprToVarenv1valletstmts=stmts1`appOL`stmts2casegetVarTypevaddrof-- sometimes we need to cast an int to a pointer before storingLMPointerty@(LMPointer_)|getVarTypevval==llvmWord->do(v,s1)<-doExprty$CastLM_Inttoptrvvaltylets2=MetaStmtmeta$Storevvaddrreturn(env2,stmts`snocOL`s1`snocOL`s2,top1++top2)LMPointer_->dolets1=MetaStmtmeta$Storevvalvaddrreturn(env2,stmts`snocOL`s1,top1++top2)i@(LMInt_)|i==llvmWord->doletvty=pLift$getVarTypevval(vptr,s1)<-doExprvty$CastLM_Inttoptrvaddrvtylets2=MetaStmtmeta$Storevvalvptrreturn(env2,stmts`snocOL`s1`snocOL`s2,top1++top2)other->pprPanic"genStore: ptr not right type!"(PprCmm.pprExpraddr<+>text("Size of Ptr: "++showllvmPtrBits++", Size of var: "++show(llvmWidthInBitsother)++", Var: "++showvaddr))-- | Unconditional branchgenBranch::LlvmEnv->BlockId->UniqSMStmtDatagenBranchenvid=letlabel=blockIdToLlvmidinreturn(env,unitOL$Branchlabel,[])-- | Conditional branchgenCondBranch::LlvmEnv->CmmExpr->BlockId->UniqSMStmtDatagenCondBranchenvcondidT=doidF<-getUniqueUsletlabelT=blockIdToLlvmidTletlabelF=LMLocalVaridFLMLabel(env',vc,stmts,top)<-exprToVarOptenvi1OptioncondifgetVarTypevc==i1thendolets1=BranchIfvclabelTlabelFlets2=MkLabelidFreturn$(env',stmts`snocOL`s1`snocOL`s2,top)elsepanic$"genCondBranch: Cond expr not bool! ("++showvc++")"-- | Switch branch---- N.B. We remove Nothing's from the list of branches, as they are 'undefined'.-- However, they may be defined one day, so we better document this behaviour.genSwitch::LlvmEnv->CmmExpr->[MaybeBlockId]->UniqSMStmtDatagenSwitchenvcondmaybe_ids=do(env',vc,stmts,top)<-exprToVarenvcondletty=getVarTypevcletpairs=[(ix,id)|(ix,Justid)<-zip[0..]maybe_ids]letlabels=map(\(ix,b)->(mkIntLittyix,blockIdToLlvmb))pairs-- out of range is undefied, so lets just branch to first labellet(_,defLbl)=headlabelslets1=SwitchvcdefLbllabelsreturn$(env',stmts`snocOL`s1,top)-- ------------------------------------------------------------------------------- * CmmExpr code generation---- | An expression conversion return data:-- * LlvmEnv: The new enviornment-- * LlvmVar: The var holding the result of the expression-- * LlvmStatements: Any statements needed to evaluate the expression-- * LlvmCmmDecl: Any global data needed for this expressiontypeExprData=(LlvmEnv,LlvmVar,LlvmStatements,[LlvmCmmDecl])-- | Values which can be passed to 'exprToVar' to configure its-- behaviour in certain circumstances.dataEOption=EOption{-- | The expected LlvmType for the returned variable.---- Currently just used for determining if a comparison should return-- a boolean (i1) or a int (i32/i64).eoExpectedType::MaybeLlvmType}i1Option::EOptioni1Option=EOption(Justi1)wordOption::EOptionwordOption=EOption(JustllvmWord)-- | Convert a CmmExpr to a list of LlvmStatements with the result of the-- expression being stored in the returned LlvmVar.exprToVar::LlvmEnv->CmmExpr->UniqSMExprDataexprToVarenv=exprToVarOptenvwordOptionexprToVarOpt::LlvmEnv->EOption->CmmExpr->UniqSMExprDataexprToVarOptenvopte=caseeofCmmLitlit->genLitenvlitCmmLoade'ty->genLoadenve'ty-- Cmmreg in expression is the value, so must load. If you want actual-- reg pointer, call getCmmReg directly.CmmRegr->dolet(env',vreg,stmts,top)=getCmmRegenvr(v1,s1)<-doExpr(pLower$getVarTypevreg)$Loadvregcase(isPointer.getVarType)v1ofTrue->do-- Cmm wants the value, so pointer types must be cast to ints(v2,s2)<-doExprllvmWord$CastLM_Ptrtointv1llvmWordreturn(env',v2,stmts`snocOL`s1`snocOL`s2,top)False->return(env',v1,stmts`snocOL`s1,top)CmmMachOpopexprs->genMachOpenvoptopexprsCmmRegOffri->exprToVarenv$expandCmmReg(r,i)CmmStackSlot__->panic"exprToVar: CmmStackSlot not supported!"-- | Handle CmmMachOp expressionsgenMachOp::LlvmEnv->EOption->MachOp->[CmmExpr]->UniqSMExprData-- Unary MachopgenMachOpenv_op[x]=caseopofMO_Notw->letall1=mkIntLit(widthToLlvmIntw)(-1)innegate(widthToLlvmIntw)all1LM_MO_XorMO_S_Negw->letall0=mkIntLit(widthToLlvmIntw)0innegate(widthToLlvmIntw)all0LM_MO_SubMO_F_Negw->letall0=LMLitVar$LMFloatLit(-0)(widthToLlvmFloatw)innegate(widthToLlvmFloatw)all0LM_MO_FSubMO_SF_Conv_w->fiConv(widthToLlvmFloatw)LM_SitofpMO_FS_Conv_w->fiConv(widthToLlvmIntw)LM_FptosiMO_SS_Convfromto->sameConvfrom(widthToLlvmIntto)LM_TruncLM_SextMO_UU_Convfromto->sameConvfrom(widthToLlvmIntto)LM_TruncLM_ZextMO_FF_Convfromto->sameConvfrom(widthToLlvmFloatto)LM_FptruncLM_Fpext-- Handle unsupported cases explicitly so we get a warning-- of missing case when new MachOps addedMO_Add_->panicOpMO_Mul_->panicOpMO_Sub_->panicOpMO_S_MulMayOflo_->panicOpMO_S_Quot_->panicOpMO_S_Rem_->panicOpMO_U_MulMayOflo_->panicOpMO_U_Quot_->panicOpMO_U_Rem_->panicOpMO_Eq_->panicOpMO_Ne_->panicOpMO_S_Ge_->panicOpMO_S_Gt_->panicOpMO_S_Le_->panicOpMO_S_Lt_->panicOpMO_U_Ge_->panicOpMO_U_Gt_->panicOpMO_U_Le_->panicOpMO_U_Lt_->panicOpMO_F_Add_->panicOpMO_F_Sub_->panicOpMO_F_Mul_->panicOpMO_F_Quot_->panicOpMO_F_Eq_->panicOpMO_F_Ne_->panicOpMO_F_Ge_->panicOpMO_F_Gt_->panicOpMO_F_Le_->panicOpMO_F_Lt_->panicOpMO_And_->panicOpMO_Or_->panicOpMO_Xor_->panicOpMO_Shl_->panicOpMO_U_Shr_->panicOpMO_S_Shr_->panicOpwherenegatetyv2negOp=do(env',vx,stmts,top)<-exprToVarenvx(v1,s1)<-doExprty$LlvmOpnegOpv2vxreturn(env',v1,stmts`snocOL`s1,top)fiConvtyconvOp=do(env',vx,stmts,top)<-exprToVarenvx(v1,s1)<-doExprty$CastconvOpvxtyreturn(env',v1,stmts`snocOL`s1,top)sameConvfromtyreduceexpand=dox'@(env',vx,stmts,top)<-exprToVarenvxletsameConv'op=do(v1,s1)<-doExprty$Castopvxtyreturn(env',v1,stmts`snocOL`s1,top)lettoWidth=llvmWidthInBitsty-- LLVM doesn't like trying to convert to same width, so-- need to check for that as we do get Cmm code doing it.casewidthInBitsfromofw|w<toWidth->sameConv'expandw|w>toWidth->sameConv'reduce_w->returnx'panicOp=panic$"LLVM.CodeGen.genMachOp: non unary op encourntered"++"with one argument! ("++showop++")"-- Handle GlobalRegs pointersgenMachOpenvopto@(MO_Add_)e@[(CmmReg(CmmGlobalr)),(CmmLit(CmmIntn_))]=genMachOp_fastenvoptor(fromIntegern)egenMachOpenvopto@(MO_Sub_)e@[(CmmReg(CmmGlobalr)),(CmmLit(CmmIntn_))]=genMachOp_fastenvoptor(negate.fromInteger$n)e-- Generic casegenMachOpenvoptope=genMachOp_slowenvoptope-- | Handle CmmMachOp expressions-- This is a specialised method that handles Global register manipulations like-- 'Sp - 16', using the getelementptr instruction.genMachOp_fast::LlvmEnv->EOption->MachOp->GlobalReg->Int->[CmmExpr]->UniqSMExprDatagenMachOp_fastenvoptoprne=letgr=lmGlobalRegVarrgrt=(pLower.getVarType)gr(ix,rem)=n`divMod`((llvmWidthInBits.pLower)grt`div`8)incaseisPointergrt&&rem==0ofTrue->do(gv,s1)<-doExprgrt$Loadgr(ptr,s2)<-doExprgrt$GetElemPtrTruegv[toI32ix](var,s3)<-doExprllvmWord$CastLM_PtrtointptrllvmWordreturn(env,var,unitOLs1`snocOL`s2`snocOL`s3,[])False->genMachOp_slowenvoptope-- | Handle CmmMachOp expressions-- This handles all the cases not handle by the specialised genMachOp_fast.genMachOp_slow::LlvmEnv->EOption->MachOp->[CmmExpr]->UniqSMExprData-- Binary MachOpgenMachOp_slowenvoptop[x,y]=caseopofMO_Eq_->genBinCompoptLM_CMP_EqMO_Ne_->genBinCompoptLM_CMP_NeMO_S_Gt_->genBinCompoptLM_CMP_SgtMO_S_Ge_->genBinCompoptLM_CMP_SgeMO_S_Lt_->genBinCompoptLM_CMP_SltMO_S_Le_->genBinCompoptLM_CMP_SleMO_U_Gt_->genBinCompoptLM_CMP_UgtMO_U_Ge_->genBinCompoptLM_CMP_UgeMO_U_Lt_->genBinCompoptLM_CMP_UltMO_U_Le_->genBinCompoptLM_CMP_UleMO_Add_->genBinMachLM_MO_AddMO_Sub_->genBinMachLM_MO_SubMO_Mul_->genBinMachLM_MO_MulMO_U_MulMayOflo_->panic"genMachOp: MO_U_MulMayOflo unsupported!"MO_S_MulMayOflow->isSMulOKwxyMO_S_Quot_->genBinMachLM_MO_SDivMO_S_Rem_->genBinMachLM_MO_SRemMO_U_Quot_->genBinMachLM_MO_UDivMO_U_Rem_->genBinMachLM_MO_URemMO_F_Eq_->genBinCompoptLM_CMP_FeqMO_F_Ne_->genBinCompoptLM_CMP_FneMO_F_Gt_->genBinCompoptLM_CMP_FgtMO_F_Ge_->genBinCompoptLM_CMP_FgeMO_F_Lt_->genBinCompoptLM_CMP_FltMO_F_Le_->genBinCompoptLM_CMP_FleMO_F_Add_->genBinMachLM_MO_FAddMO_F_Sub_->genBinMachLM_MO_FSubMO_F_Mul_->genBinMachLM_MO_FMulMO_F_Quot_->genBinMachLM_MO_FDivMO_And_->genBinMachLM_MO_AndMO_Or_->genBinMachLM_MO_OrMO_Xor_->genBinMachLM_MO_XorMO_Shl_->genBinMachLM_MO_ShlMO_U_Shr_->genBinMachLM_MO_LShrMO_S_Shr_->genBinMachLM_MO_AShrMO_Not_->panicOpMO_S_Neg_->panicOpMO_F_Neg_->panicOpMO_SF_Conv__->panicOpMO_FS_Conv__->panicOpMO_SS_Conv__->panicOpMO_UU_Conv__->panicOpMO_FF_Conv__->panicOpwherebinLlvmOptybinOp=do(env1,vx,stmts1,top1)<-exprToVarenvx(env2,vy,stmts2,top2)<-exprToVarenv1yifgetVarTypevx==getVarTypevythendo(v1,s1)<-doExpr(tyvx)$binOpvxvyreturn(env2,v1,stmts1`appOL`stmts2`snocOL`s1,top1++top2)elsedo-- Error. Continue anyway so we can debug the generated ll file.letdflags=getDflagsenvstyle=mkCodeStyleCStyletoStringdoc=renderWithStyledflagsdocstylecmmToStr=(lines.toString.PprCmm.pprExpr)letdx=Comment$mapfsLit$cmmToStrxletdy=Comment$mapfsLit$cmmToStry(v1,s1)<-doExpr(tyvx)$binOpvxvyletallStmts=stmts1`appOL`stmts2`snocOL`dx`snocOL`dy`snocOL`s1return(env2,v1,allStmts,top1++top2)-- | Need to use EOption here as Cmm expects word size results from-- comparisons while LLVM return i1. Need to extend to llvmWord type-- if expectedgenBinCompoptcmp=doed@(env',v1,stmts,top)<-binLlvmOp(\_->i1)$ComparecmpifgetVarTypev1==i1thencaseeoExpectedTypeoptofNothing->returnedJustt|t==i1->returned|isIntt->do(v2,s1)<-doExprt$CastLM_Zextv1treturn(env',v2,stmts`snocOL`s1,top)|otherwise->panic$"genBinComp: Can't case i1 compare"++"res to non int type "++show(t)elsepanic$"genBinComp: Compare returned type other then i1! "++(show$getVarTypev1)genBinMachop=binLlvmOpgetVarType(LlvmOpop)-- | Detect if overflow will occur in signed multiply of the two-- CmmExpr's. This is the LLVM assembly equivalent of the NCG-- implementation. Its much longer due to type information/safety.-- This should actually compile to only about 3 asm instructions.isSMulOK::Width->CmmExpr->CmmExpr->UniqSMExprDataisSMulOK_xy=do(env1,vx,stmts1,top1)<-exprToVarenvx(env2,vy,stmts2,top2)<-exprToVarenv1yletword=getVarTypevxletword2=LMInt$2*(llvmWidthInBits$getVarTypevx)letshift=llvmWidthInBitswordletshift1=toIWord(shift-1)letshift2=toIWordshiftifisIntwordthendo(x1,s1)<-doExprword2$CastLM_Sextvxword2(y1,s2)<-doExprword2$CastLM_Sextvyword2(r1,s3)<-doExprword2$LlvmOpLM_MO_Mulx1y1(rlow1,s4)<-doExprword$CastLM_Truncr1word(rlow2,s5)<-doExprword$LlvmOpLM_MO_AShrrlow1shift1(rhigh1,s6)<-doExprword2$LlvmOpLM_MO_AShrr1shift2(rhigh2,s7)<-doExprword$CastLM_Truncrhigh1word(dst,s8)<-doExprword$LlvmOpLM_MO_Subrlow2rhigh2letstmts=(unitOLs1)`snocOL`s2`snocOL`s3`snocOL`s4`snocOL`s5`snocOL`s6`snocOL`s7`snocOL`s8return(env2,dst,stmts1`appOL`stmts2`appOL`stmts,top1++top2)elsepanic$"isSMulOK: Not bit type! ("++showword++")"panicOp=panic$"LLVM.CodeGen.genMachOp_slow: unary op encourntered"++"with two arguments! ("++showop++")"-- More then two expression, invalid!genMachOp_slow____=panic"genMachOp: More then 2 expressions in MachOp!"-- | Handle CmmLoad expression.genLoad::LlvmEnv->CmmExpr->CmmType->UniqSMExprData-- First we try to detect a few common cases and produce better code for-- these then the default case. We are mostly trying to detect Cmm code-- like I32[Sp + n] and use 'getelementptr' operations instead of the-- generic case that uses casts and pointer arithmeticgenLoadenve@(CmmReg(CmmGlobalr))ty=genLoad_fastenver0tygenLoadenve@(CmmRegOff(CmmGlobalr)n)ty=genLoad_fastenverntygenLoadenve@(CmmMachOp(MO_Add_)[(CmmReg(CmmGlobalr)),(CmmLit(CmmIntn_))])ty=genLoad_fastenver(fromIntegern)tygenLoadenve@(CmmMachOp(MO_Sub_)[(CmmReg(CmmGlobalr)),(CmmLit(CmmIntn_))])ty=genLoad_fastenver(negate$fromIntegern)ty-- generic casegenLoadenvety=genLoad_slowenvety[other]-- | Handle CmmLoad expression.-- This is a special case for loading from a global register pointer-- offset such as I32[Sp+8].genLoad_fast::LlvmEnv->CmmExpr->GlobalReg->Int->CmmType->UniqSMExprDatagenLoad_fastenvernty=letgr=lmGlobalRegVarrmeta=[getTBAAr]grt=(pLower.getVarType)grty'=cmmToLlvmTypety(ix,rem)=n`divMod`((llvmWidthInBits.pLower)grt`div`8)incaseisPointergrt&&rem==0ofTrue->do(gv,s1)<-doExprgrt$Loadgr(ptr,s2)<-doExprgrt$GetElemPtrTruegv[toI32ix]-- We might need a different pointer type, so checkcasegrt==ty'of-- were fineTrue->do(var,s3)<-doExprty'(MetaExprmeta$Loadptr)return(env,var,unitOLs1`snocOL`s2`snocOL`s3,[])-- cast to pointer type neededFalse->doletpty=pLiftty'(ptr',s3)<-doExprpty$CastLM_Bitcastptrpty(var,s4)<-doExprty'(MetaExprmeta$Loadptr')return(env,var,unitOLs1`snocOL`s2`snocOL`s3`snocOL`s4,[])-- If its a bit type then we use the slow method since-- we can't avoid casting anyway.False->genLoad_slowenvetymeta-- | Handle Cmm load expression.-- Generic case. Uses casts and pointer arithmetic if needed.genLoad_slow::LlvmEnv->CmmExpr->CmmType->[MetaData]->UniqSMExprDatagenLoad_slowenvetymeta=do(env',iptr,stmts,tops)<-exprToVarenvecasegetVarTypeiptrofLMPointer_->do(dvar,load)<-doExpr(cmmToLlvmTypety)(MetaExprmeta$Loadiptr)return(env',dvar,stmts`snocOL`load,tops)i@(LMInt_)|i==llvmWord->doletpty=LMPointer$cmmToLlvmTypety(ptr,cast)<-doExprpty$CastLM_Inttoptriptrpty(dvar,load)<-doExpr(cmmToLlvmTypety)(MetaExprmeta$Loadptr)return(env',dvar,stmts`snocOL`cast`snocOL`load,tops)other->pprPanic"exprToVar: CmmLoad expression is not right type!"(PprCmm.pprExpre<+>text("Size of Ptr: "++showllvmPtrBits++", Size of var: "++show(llvmWidthInBitsother)++", Var: "++showiptr))-- | Handle CmmReg expression---- We allocate CmmReg on the stack. This avoids having to map a CmmReg to an-- equivalent SSA form and avoids having to deal with Phi node insertion.-- This is also the approach recommended by LLVM developers.getCmmReg::LlvmEnv->CmmReg->ExprDatagetCmmRegenvr@(CmmLocal(LocalRegun_))=letexists=varLookupunenv(newv,stmts)=allocRegrnenv=varInsertun(pLower$getVarTypenewv)envincaseexistsofJustety->(env,(LMLocalVarun$pLiftety),nilOL,[])Nothing->(nenv,newv,stmts,[])getCmmRegenv(CmmGlobalg)=(env,lmGlobalRegVarg,nilOL,[])-- | Allocate a CmmReg on the stackallocReg::CmmReg->(LlvmVar,LlvmStatements)allocReg(CmmLocal(LocalRegunty))=letty'=cmmToLlvmTypetyvar=LMLocalVarun(LMPointerty')alc=Allocaty'1in(var,unitOL$Assignmentvaralc)allocReg_=panic$"allocReg: Global reg encountered! Global registers should"++" have been handled elsewhere!"-- | Generate code for a literalgenLit::LlvmEnv->CmmLit->UniqSMExprDatagenLitenv(CmmIntiw)=return(env,mkIntLit(LMInt$widthInBitsw)i,nilOL,[])genLitenv(CmmFloatrw)=return(env,LMLitVar$LMFloatLit(fromRationalr)(widthToLlvmFloatw),nilOL,[])genLitenvcmm@(CmmLabell)=letlabel=strCLabel_llvmenvlty=funLookuplabelenvlmty=cmmToLlvmType$cmmLitTypecmmincasetyof-- Make generic external label definition and then pointer to itNothing->doletglob@(var,_)=genStringLabelReflabelletldata=[CmmDataData[([glob],[])]]letenv'=funInsertlabel(pLower$getVarTypevar)env(v1,s1)<-doExprlmty$CastLM_PtrtointvarllvmWordreturn(env',v1,unitOLs1,ldata)-- Referenced data exists in this module, retrieve type and make-- pointer to it.Justty'->doletvar=LMGlobalVarlabel(LMPointerty')ExternallyVisibleNothingNothingFalse(v1,s1)<-doExprlmty$CastLM_PtrtointvarllvmWordreturn(env,v1,unitOLs1,[])genLitenv(CmmLabelOfflabeloff)=do(env',vlbl,stmts,stat)<-genLitenv(CmmLabellabel)letvoff=toIWordoff(v1,s1)<-doExpr(getVarTypevlbl)$LlvmOpLM_MO_Addvlblvoffreturn(env',v1,stmts`snocOL`s1,stat)genLitenv(CmmLabelDiffOffl1l2off)=do(env1,vl1,stmts1,stat1)<-genLitenv(CmmLabell1)(env2,vl2,stmts2,stat2)<-genLitenv1(CmmLabell2)letvoff=toIWordoffletty1=getVarTypevl1letty2=getVarTypevl2if(isIntty1)&&(isIntty2)&&(llvmWidthInBitsty1==llvmWidthInBitsty2)thendo(v1,s1)<-doExpr(getVarTypevl1)$LlvmOpLM_MO_Subvl1vl2(v2,s2)<-doExpr(getVarTypev1)$LlvmOpLM_MO_Addv1voffreturn(env2,v2,stmts1`appOL`stmts2`snocOL`s1`snocOL`s2,stat1++stat2)elsepanic"genLit: CmmLabelDiffOff encountered with different label ty!"genLitenv(CmmBlockb)=genLitenv(CmmLabel$infoTblLblb)genLit_CmmHighStackMark=panic"genStaticLit - CmmHighStackMark unsupported!"-- ------------------------------------------------------------------------------- * Misc---- | Function prologue. Load STG arguments into variables for function.funPrologue::[LlvmStatement]funPrologue=concat$mapgetRegactiveStgRegswheregetRegrr=letreg=lmGlobalRegVarrrarg=lmGlobalRegArgrralloc=Assignmentreg$Alloca(pLower$getVarTypereg)1in[alloc,Storeargreg]-- | Function epilogue. Load STG variables to use as argument for call.-- STG Liveness optimisation done here.funEpilogue::LlvmEnv->Maybe[GlobalReg]->UniqSM([LlvmVar],LlvmStatements)-- Have information and liveness optimisation is enabledfunEpilogueenv(Justlive)|doptOpt_RegLiveness(getDflagsenv)=doloads<-mapMloadExpractiveStgRegslet(vars,stmts)=unziploadsreturn(vars,concatOLstmts)whereloadExprr|r`elem`alwaysLive||r`elem`live=doletreg=lmGlobalRegVarr(v,s)<-doExpr(pLower$getVarTypereg)$Loadregreturn(v,unitOLs)loadExprr=doletty=(pLower.getVarType$lmGlobalRegVarr)return(LMLitVar$LMUndefLitty,unitOLNop)-- don't do liveness optimisationfunEpilogue__=doloads<-mapMloadExpractiveStgRegslet(vars,stmts)=unziploadsreturn(vars,concatOLstmts)whereloadExprr=doletreg=lmGlobalRegVarr(v,s)<-doExpr(pLower$getVarTypereg)$Loadregreturn(v,unitOLs)-- | A serries of statements to trash all the STG registers.---- In LLVM we pass the STG registers around everywhere in function calls.-- So this means LLVM considers them live across the entire function, when-- in reality they usually aren't. For Caller save registers across C calls-- the saving and restoring of them is done by the Cmm code generator,-- using Cmm local vars. So to stop LLVM saving them as well (and saving-- all of them since it thinks they're always live, we trash them just-- before the call by assigning the 'undef' value to them. The ones we-- need are restored from the Cmm local var and the ones we don't need-- are fine to be trashed.trashStmts::LlvmStatementstrashStmts=concatOL$maptrashRegactiveStgRegswheretrashRegr=letreg=lmGlobalRegVarrty=(pLower.getVarType)regtrash=unitOL$Store(LMLitVar$LMUndefLitty)regincasecallerSavesrofTrue->trashFalse->nilOL-- | Get a function pointer to the CLabel specified.---- This is for Haskell functions, function type is assumed, so doesn't work-- with foreign functions.getHsFunc::LlvmEnv->CLabel->UniqSMExprDatagetHsFuncenvlbl=letfn=strCLabel_llvmenvlblty=funLookupfnenvincasetyof-- Function in module in right formJustty'@(LMFunctionsig)->doletfun=LMGlobalVarfnty'(funcLinkagesig)NothingNothingFalsereturn(env,fun,nilOL,[])-- label in module but not function pointer, convertJustty'->doletfun=LMGlobalVarfn(pLiftty')ExternallyVisibleNothingNothingFalse(v1,s1)<-doExpr(pLiftllvmFunTy)$CastLM_Bitcastfun(pLiftllvmFunTy)return(env,v1,unitOLs1,[])-- label not in module, create external referenceNothing->doletty'=LMFunction$llvmFunSigenvlblExternallyVisibleletfun=LMGlobalVarfnty'ExternallyVisibleNothingNothingFalselettop=CmmDataData[([],[ty'])]letenv'=funInsertfnty'envreturn(env',fun,nilOL,[top])-- | Create a new local varmkLocalVar::LlvmType->UniqSMLlvmVarmkLocalVarty=doun<-getUniqueUsreturn$LMLocalVarunty-- | Execute an expression, assigning result to a vardoExpr::LlvmType->LlvmExpression->UniqSM(LlvmVar,LlvmStatement)doExprtyexpr=dov<-mkLocalVartyreturn(v,Assignmentvexpr)-- | Expand CmmRegOffexpandCmmReg::(CmmReg,Int)->CmmExprexpandCmmReg(reg,off)=letwidth=typeWidth(cmmRegTypereg)voff=CmmLit$CmmInt(fromIntegraloff)widthinCmmMachOp(MO_Addwidth)[CmmRegreg,voff]-- | Convert a block id into a appropriate Llvm labelblockIdToLlvm::BlockId->LlvmVarblockIdToLlvmbid=LMLocalVar(getUniquebid)LMLabel-- | Create Llvm int LiteralmkIntLit::Integrala=>LlvmType->a->LlvmVarmkIntLittyi=LMLitVar$LMIntLit(toIntegeri)ty-- | Convert int type to a LLvmVar of word or i32 sizetoI32,toIWord::Integrala=>a->LlvmVartoI32=mkIntLiti32toIWord=mkIntLitllvmWord-- | Error functionspanic::String->apanics=Outputable.panic$"LlvmCodeGen.CodeGen."++spprPanic::String->SDoc->apprPanicsd=Outputable.pprPanic("LlvmCodeGen.CodeGen."++s)d