{-# LANGUAGE CPP #-}--------------------------------------------------------------------------------- Machine-dependent assembly language---- (c) The University of Glasgow 1993-2004-------------------------------------------------------------------------------#include "HsVersions.h"
#include "nativeGen/NCG.h"
modulePPC.Instr(archWordFormat ,RI (..),Instr (..),stackFrameHeaderSize ,maxSpillSlots ,allocMoreStack ,makeFarBranches )whereimportGhcPreludeimportPPC.Regs importPPC.Cond importInstruction importFormat importTargetReg importRegClass importReg importCodeGen.Platform importBlockId importHoopl.Collections importHoopl.Label importDynFlagsimportCmm importCmmInfo importFastStringimportCLabel importOutputableimportPlatformimportUniqFM(listToUFM,lookupUFM)importUniqSupplyimportControl.Monad(replicateM)importData.Maybe(fromMaybe)---------------------------------------------------------------------------------- Format of a PPC memory address.--archWordFormat::Bool->Format archWordFormat is32Bit |is32Bit =II32 |otherwise=II64 -- | Instruction instance for powerpcinstanceInstruction Instr whereregUsageOfInstr =ppc_regUsageOfInstr patchRegsOfInstr =ppc_patchRegsOfInstr isJumpishInstr =ppc_isJumpishInstr jumpDestsOfInstr =ppc_jumpDestsOfInstr patchJumpInstr =ppc_patchJumpInstr mkSpillInstr =ppc_mkSpillInstr mkLoadInstr =ppc_mkLoadInstr takeDeltaInstr =ppc_takeDeltaInstr isMetaInstr =ppc_isMetaInstr mkRegRegMoveInstr _=ppc_mkRegRegMoveInstr takeRegRegMoveInstr =ppc_takeRegRegMoveInstr mkJumpInstr =ppc_mkJumpInstr mkStackAllocInstr =ppc_mkStackAllocInstr mkStackDeallocInstr =ppc_mkStackDeallocInstr ppc_mkStackAllocInstr::Platform->Int->[Instr ]ppc_mkStackAllocInstr platform amount =ppc_mkStackAllocInstr' platform (-amount )ppc_mkStackDeallocInstr::Platform->Int->[Instr ]ppc_mkStackDeallocInstr platform amount =ppc_mkStackAllocInstr' platform amount ppc_mkStackAllocInstr'::Platform->Int->[Instr ]ppc_mkStackAllocInstr' platform amount |fits16Bits amount =[LD fmt r0 (AddrRegImm sp zero ),STU fmt r0 (AddrRegImm sp immAmount )]|otherwise=[LD fmt r0 (AddrRegImm sp zero ),ADDIS tmp sp (HA immAmount ),ADD tmp tmp (RIImm (LO immAmount )),STU fmt r0 (AddrRegReg sp tmp )]wherefmt =intFormat $widthFromBytes((platformWordSizeplatform )`quot`8)zero =ImmInt 0tmp =tmpReg platform immAmount =ImmInt amount ---- See note [extra spill slots] in X86/Instr.hs--allocMoreStack::Platform->Int->NatCmmDecl statics PPC.Instr.Instr ->UniqSM(NatCmmDecl statics PPC.Instr.Instr ,[(BlockId ,BlockId )])allocMoreStack __top @(CmmData __)=return(top ,[])allocMoreStackplatform slots (CmmProc info lbl live (ListGraph code ))=doletinfos =mapKeys info entries =casecode of[]->infos BasicBlock entry _:_-- first block is the entry point|entry `elem`infos ->infos |otherwise->entry :infos uniqs <-replicateM(lengthentries )getUniqueMletdelta =((x +stackAlign -1)`quot`stackAlign )*stackAlign -- round upwherex =slots *spillSlotSize -- sp deltaalloc =mkStackAllocInstr platform delta dealloc =mkStackDeallocInstr platform delta retargetList =(zipentries (mapmkBlockId uniqs ))new_blockmap::LabelMap BlockId new_blockmap =mapFromList retargetList insert_stack_insns (BasicBlock id insns )|Justnew_blockid <-mapLookup id new_blockmap =[BasicBlock id $alloc ++[BCC ALWAYS new_blockid Nothing],BasicBlock new_blockid block' ]|otherwise=[BasicBlock id block' ]whereblock' =foldrinsert_dealloc []insns insert_dealloc insn r -- BCTR might or might not be a non-local jump. For-- "labeled-goto" we use JMP, and for "computed-goto" we-- use MTCTR followed by BCTR. See 'PPC.CodeGen.genJump'.=caseinsn ofJMP __->dealloc ++(insn :r )BCTR []Nothing_->dealloc ++(insn :r )BCTR ids labelrs ->BCTR (map(fmapretarget )ids )labelrs :r BCCFAR cond b p ->BCCFAR cond (retarget b )p :r BCC cond b p ->BCC cond (retarget b )p :r _->insn :r -- BL and BCTRL are call-like instructions rather than-- jumps, and are used only for C calls.retarget::BlockId ->BlockId retarget b =fromMaybeb (mapLookup b new_blockmap )new_code =concatMapinsert_stack_insns code -- inreturn(CmmProc info lbl live (ListGraph new_code ),retargetList )-- ------------------------------------------------------------------------------- Machine's assembly language-- We have a few common "instructions" (nearly all the pseudo-ops) but-- mostly all of 'Instr' is machine-specific.-- Register or immediatedataRI =RIReg Reg |RIImm Imm dataInstr -- comment pseudo-op=COMMENT FastString-- some static data spat out during code-- generation. Will be extracted before-- pretty-printing.|LDATA Section CmmStatics -- start a new basic block. Useful during-- codegen, removed later. Preceding-- instruction should be a jump, as per the-- invariants for a BasicBlock (see Cmm).|NEWBLOCK BlockId -- specify current stack offset for-- benefit of subsequent passes|DELTA Int-- Loads and stores.|LD Format Reg AddrMode -- Load format, dst, src|LDFAR Format Reg AddrMode -- Load format, dst, src 32 bit offset|LDR Format Reg AddrMode -- Load and reserve format, dst, src|LA Format Reg AddrMode -- Load arithmetic format, dst, src|ST Format Reg AddrMode -- Store format, src, dst|STFAR Format Reg AddrMode -- Store format, src, dst 32 bit offset|STU Format Reg AddrMode -- Store with Update format, src, dst|STC Format Reg AddrMode -- Store conditional format, src, dst|LIS Reg Imm -- Load Immediate Shifted dst, src|LI Reg Imm -- Load Immediate dst, src|MR Reg Reg -- Move Register dst, src -- also for fmr|CMP Format Reg RI -- format, src1, src2|CMPL Format Reg RI -- format, src1, src2|BCC Cond BlockId (MaybeBool)-- cond, block, hint|BCCFAR Cond BlockId (MaybeBool)-- cond, block, hint-- hint:-- Just True: branch likely taken-- Just False: branch likely not taken-- Nothing: no hint|JMP CLabel [Reg ]-- same as branch,-- but with CLabel instead of block ID-- and live global registers|MTCTR Reg |BCTR [MaybeBlockId ](MaybeCLabel )[Reg ]-- with list of local destinations, and-- jump table location if necessary|BL CLabel [Reg ]-- with list of argument regs|BCTRL [Reg ]|ADD Reg Reg RI -- dst, src1, src2|ADDO Reg Reg Reg -- add and set overflow|ADDC Reg Reg Reg -- (carrying) dst, src1, src2|ADDE Reg Reg Reg -- (extended) dst, src1, src2|ADDZE Reg Reg -- (to zero extended) dst, src|ADDIS Reg Reg Imm -- Add Immediate Shifted dst, src1, src2|SUBF Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1|SUBFO Reg Reg Reg -- subtract from and set overflow|SUBFC Reg Reg RI -- (carrying) dst, src1, src2 ;-- dst = src2 - src1|SUBFE Reg Reg Reg -- (extended) dst, src1, src2 ;-- dst = src2 - src1|MULL Format Reg Reg RI |MULLO Format Reg Reg Reg -- multiply and set overflow|MFOV Format Reg -- move overflow bit (1|33) to register-- pseudo-instruction; pretty printed as-- mfxer dst-- extr[w|d]i dst, dst, 1, [1|33]|MULHU Format Reg Reg Reg |DIV Format BoolReg Reg Reg |AND Reg Reg RI -- dst, src1, src2|ANDC Reg Reg Reg -- AND with complement, dst = src1 & ~ src2|NAND Reg Reg Reg -- dst, src1, src2|OR Reg Reg RI -- dst, src1, src2|ORIS Reg Reg Imm -- OR Immediate Shifted dst, src1, src2|XOR Reg Reg RI -- dst, src1, src2|XORIS Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2|EXTS Format Reg Reg |CNTLZ Format Reg Reg |NEG Reg Reg |NOT Reg Reg |SL Format Reg Reg RI -- shift left|SR Format Reg Reg RI -- shift right|SRA Format Reg Reg RI -- shift right arithmetic|RLWINM Reg Reg IntIntInt-- Rotate Left Word Immediate then AND with Mask|CLRLI Format Reg Reg Int-- clear left immediate (extended mnemonic)|CLRRI Format Reg Reg Int-- clear right immediate (extended mnemonic)|FADD Format Reg Reg Reg |FSUB Format Reg Reg Reg |FMUL Format Reg Reg Reg |FDIV Format Reg Reg Reg |FABS Reg Reg -- abs is the same for single and double|FNEG Reg Reg -- negate is the same for single and double prec.|FCMP Reg Reg |FCTIWZ Reg Reg -- convert to integer word|FCTIDZ Reg Reg -- convert to integer double word|FCFID Reg Reg -- convert from integer double word|FRSP Reg Reg -- reduce to single precision-- (but destination is a FP register)|CRNOR IntIntInt-- condition register nor|MFCR Reg -- move from condition register|MFLR Reg -- move from link register|FETCHPC Reg -- pseudo-instruction:-- bcl to next insn, mflr reg|HWSYNC -- heavy weight sync|ISYNC -- instruction synchronize|LWSYNC -- memory barrier|NOP -- no operation, PowerPC 64 bit-- needs this as place holder to-- reload TOC pointer-- | Get the registers that are being used by this instruction.-- regUsage doesn't need to do any trickery for jumps and such.-- Just state precisely the regs read and written by that insn.-- The consequences of control flow transfers, as far as register-- allocation goes, are taken care of by the register allocator.--ppc_regUsageOfInstr::Platform->Instr ->RegUsage ppc_regUsageOfInstr platform instr =caseinstr ofLD _reg addr ->usage (regAddr addr ,[reg ])LDFAR _reg addr ->usage (regAddr addr ,[reg ])LDR _reg addr ->usage (regAddr addr ,[reg ])LA _reg addr ->usage (regAddr addr ,[reg ])ST _reg addr ->usage (reg :regAddr addr ,[])STFAR _reg addr ->usage (reg :regAddr addr ,[])STU _reg addr ->usage (reg :regAddr addr ,[])STC _reg addr ->usage (reg :regAddr addr ,[])LIS reg _->usage ([],[reg ])LI reg _->usage ([],[reg ])MR reg1 reg2 ->usage ([reg2 ],[reg1 ])CMP _reg ri ->usage (reg :regRI ri ,[])CMPL _reg ri ->usage (reg :regRI ri ,[])BCC ___->noUsage BCCFAR ___->noUsage JMP _regs ->usage (regs ,[])MTCTR reg ->usage ([reg ],[])BCTR __regs ->usage (regs ,[])BL _params ->usage (params ,callClobberedRegs platform )BCTRL params ->usage (params ,callClobberedRegs platform )ADD reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])ADDO reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])ADDC reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])ADDE reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])ADDZE reg1 reg2 ->usage ([reg2 ],[reg1 ])ADDIS reg1 reg2 _->usage ([reg2 ],[reg1 ])SUBF reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])SUBFO reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])SUBFC reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])SUBFE reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])MULL _reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])MULLO _reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])MFOV _reg ->usage ([],[reg ])MULHU _reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])DIV __reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])AND reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])ANDC reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])NAND reg1 reg2 reg3 ->usage ([reg2 ,reg3 ],[reg1 ])OR reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])ORIS reg1 reg2 _->usage ([reg2 ],[reg1 ])XOR reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])XORIS reg1 reg2 _->usage ([reg2 ],[reg1 ])EXTS _reg1 reg2 ->usage ([reg2 ],[reg1 ])CNTLZ _reg1 reg2 ->usage ([reg2 ],[reg1 ])NEG reg1 reg2 ->usage ([reg2 ],[reg1 ])NOT reg1 reg2 ->usage ([reg2 ],[reg1 ])SL _reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])SR _reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])SRA _reg1 reg2 ri ->usage (reg2 :regRI ri ,[reg1 ])RLWINM reg1 reg2 ___->usage ([reg2 ],[reg1 ])CLRLI _reg1 reg2 _->usage ([reg2 ],[reg1 ])CLRRI _reg1 reg2 _->usage ([reg2 ],[reg1 ])FADD _r1 r2 r3 ->usage ([r2 ,r3 ],[r1 ])FSUB _r1 r2 r3 ->usage ([r2 ,r3 ],[r1 ])FMUL _r1 r2 r3 ->usage ([r2 ,r3 ],[r1 ])FDIV _r1 r2 r3 ->usage ([r2 ,r3 ],[r1 ])FABS r1 r2 ->usage ([r2 ],[r1 ])FNEG r1 r2 ->usage ([r2 ],[r1 ])FCMP r1 r2 ->usage ([r1 ,r2 ],[])FCTIWZ r1 r2 ->usage ([r2 ],[r1 ])FCTIDZ r1 r2 ->usage ([r2 ],[r1 ])FCFID r1 r2 ->usage ([r2 ],[r1 ])FRSP r1 r2 ->usage ([r2 ],[r1 ])MFCR reg ->usage ([],[reg ])MFLR reg ->usage ([],[reg ])FETCHPC reg ->usage ([],[reg ])_->noUsage whereusage (src ,dst )=RU (filter(interesting platform )src )(filter(interesting platform )dst )regAddr (AddrRegReg r1 r2 )=[r1 ,r2 ]regAddr(AddrRegImm r1 _)=[r1 ]regRI (RIReg r )=[r ]regRI_=[]interesting::Platform->Reg ->Boolinteresting _(RegVirtual _)=Trueinterestingplatform (RegReal (RealRegSingle i ))=freeReg platform i interesting_(RegReal (RealRegPair {}))=panic"PPC.Instr.interesting: no reg pairs on this arch"-- | Apply a given mapping to all the register references in this-- instruction.ppc_patchRegsOfInstr::Instr ->(Reg ->Reg )->Instr ppc_patchRegsOfInstr instr env =caseinstr ofLD fmt reg addr ->LD fmt (env reg )(fixAddr addr )LDFAR fmt reg addr ->LDFAR fmt (env reg )(fixAddr addr )LDR fmt reg addr ->LDR fmt (env reg )(fixAddr addr )LA fmt reg addr ->LA fmt (env reg )(fixAddr addr )ST fmt reg addr ->ST fmt (env reg )(fixAddr addr )STFAR fmt reg addr ->STFAR fmt (env reg )(fixAddr addr )STU fmt reg addr ->STU fmt (env reg )(fixAddr addr )STC fmt reg addr ->STC fmt (env reg )(fixAddr addr )LIS reg imm ->LIS (env reg )imm LI reg imm ->LI (env reg )imm MR reg1 reg2 ->MR (env reg1 )(env reg2 )CMP fmt reg ri ->CMP fmt (env reg )(fixRI ri )CMPL fmt reg ri ->CMPL fmt (env reg )(fixRI ri )BCC cond lbl p ->BCC cond lbl p BCCFAR cond lbl p ->BCCFAR cond lbl p JMP l regs ->JMP l regs -- global regs will not be remappedMTCTR reg ->MTCTR (env reg )BCTR targets lbl rs ->BCTR targets lbl rs BL imm argRegs ->BL imm argRegs -- argument regsBCTRL argRegs ->BCTRL argRegs -- cannot be remappedADD reg1 reg2 ri ->ADD (env reg1 )(env reg2 )(fixRI ri )ADDO reg1 reg2 reg3 ->ADDO (env reg1 )(env reg2 )(env reg3 )ADDC reg1 reg2 reg3 ->ADDC (env reg1 )(env reg2 )(env reg3 )ADDE reg1 reg2 reg3 ->ADDE (env reg1 )(env reg2 )(env reg3 )ADDZE reg1 reg2 ->ADDZE (env reg1 )(env reg2 )ADDIS reg1 reg2 imm ->ADDIS (env reg1 )(env reg2 )imm SUBF reg1 reg2 reg3 ->SUBF (env reg1 )(env reg2 )(env reg3 )SUBFO reg1 reg2 reg3 ->SUBFO (env reg1 )(env reg2 )(env reg3 )SUBFC reg1 reg2 ri ->SUBFC (env reg1 )(env reg2 )(fixRI ri )SUBFE reg1 reg2 reg3 ->SUBFE (env reg1 )(env reg2 )(env reg3 )MULL fmt reg1 reg2 ri ->MULL fmt (env reg1 )(env reg2 )(fixRI ri )MULLO fmt reg1 reg2 reg3 ->MULLO fmt (env reg1 )(env reg2 )(env reg3 )MFOV fmt reg ->MFOV fmt (env reg )MULHU fmt reg1 reg2 reg3 ->MULHU fmt (env reg1 )(env reg2 )(env reg3 )DIV fmt sgn reg1 reg2 reg3 ->DIV fmt sgn (env reg1 )(env reg2 )(env reg3 )AND reg1 reg2 ri ->AND (env reg1 )(env reg2 )(fixRI ri )ANDC reg1 reg2 reg3 ->ANDC (env reg1 )(env reg2 )(env reg3 )NAND reg1 reg2 reg3 ->NAND (env reg1 )(env reg2 )(env reg3 )OR reg1 reg2 ri ->OR (env reg1 )(env reg2 )(fixRI ri )ORIS reg1 reg2 imm ->ORIS (env reg1 )(env reg2 )imm XOR reg1 reg2 ri ->XOR (env reg1 )(env reg2 )(fixRI ri )XORIS reg1 reg2 imm ->XORIS (env reg1 )(env reg2 )imm EXTS fmt reg1 reg2 ->EXTS fmt (env reg1 )(env reg2 )CNTLZ fmt reg1 reg2 ->CNTLZ fmt (env reg1 )(env reg2 )NEG reg1 reg2 ->NEG (env reg1 )(env reg2 )NOT reg1 reg2 ->NOT (env reg1 )(env reg2 )SL fmt reg1 reg2 ri ->SL fmt (env reg1 )(env reg2 )(fixRI ri )SR fmt reg1 reg2 ri ->SR fmt (env reg1 )(env reg2 )(fixRI ri )SRA fmt reg1 reg2 ri ->SRA fmt (env reg1 )(env reg2 )(fixRI ri )RLWINM reg1 reg2 sh mb me ->RLWINM (env reg1 )(env reg2 )sh mb me CLRLI fmt reg1 reg2 n ->CLRLI fmt (env reg1 )(env reg2 )n CLRRI fmt reg1 reg2 n ->CLRRI fmt (env reg1 )(env reg2 )n FADD fmt r1 r2 r3 ->FADD fmt (env r1 )(env r2 )(env r3 )FSUB fmt r1 r2 r3 ->FSUB fmt (env r1 )(env r2 )(env r3 )FMUL fmt r1 r2 r3 ->FMUL fmt (env r1 )(env r2 )(env r3 )FDIV fmt r1 r2 r3 ->FDIV fmt (env r1 )(env r2 )(env r3 )FABS r1 r2 ->FABS (env r1 )(env r2 )FNEG r1 r2 ->FNEG (env r1 )(env r2 )FCMP r1 r2 ->FCMP (env r1 )(env r2 )FCTIWZ r1 r2 ->FCTIWZ (env r1 )(env r2 )FCTIDZ r1 r2 ->FCTIDZ (env r1 )(env r2 )FCFID r1 r2 ->FCFID (env r1 )(env r2 )FRSP r1 r2 ->FRSP (env r1 )(env r2 )MFCR reg ->MFCR (env reg )MFLR reg ->MFLR (env reg )FETCHPC reg ->FETCHPC (env reg )_->instr wherefixAddr (AddrRegReg r1 r2 )=AddrRegReg (env r1 )(env r2 )fixAddr(AddrRegImm r1 i )=AddrRegImm (env r1 )i fixRI (RIReg r )=RIReg (env r )fixRIother =other ---------------------------------------------------------------------------------- | Checks whether this instruction is a jump/branch instruction.-- One that can change the flow of control in a way that the-- register allocator needs to worry about.ppc_isJumpishInstr::Instr ->Boolppc_isJumpishInstr instr =caseinstr ofBCC {}->TrueBCCFAR {}->TrueBCTR {}->TrueBCTRL {}->TrueBL {}->TrueJMP {}->True_->False-- | Checks whether this instruction is a jump/branch instruction.-- One that can change the flow of control in a way that the-- register allocator needs to worry about.ppc_jumpDestsOfInstr::Instr ->[BlockId ]ppc_jumpDestsOfInstr insn =caseinsn ofBCC _id _->[id ]BCCFAR _id _->[id ]BCTR targets __->[id |Justid <-targets ]_->[]-- | Change the destination of this jump instruction.-- Used in the linear allocator when adding fixup blocks for join-- points.ppc_patchJumpInstr::Instr ->(BlockId ->BlockId )->Instr ppc_patchJumpInstr insn patchF =caseinsn ofBCC cc id p ->BCC cc (patchF id )p BCCFAR cc id p ->BCCFAR cc (patchF id )p BCTR ids lbl rs ->BCTR (map(fmappatchF )ids )lbl rs _->insn -- ------------------------------------------------------------------------------- | An instruction to spill a register into a spill slot.ppc_mkSpillInstr::DynFlags->Reg -- register to spill->Int-- current stack delta->Int-- spill slot to use->Instr ppc_mkSpillInstr dflags reg delta slot =letplatform =targetPlatformdflags off =spillSlotToOffset dflags slot arch =platformArchplatform inletfmt =casetargetClassOfReg platform reg ofRcInteger ->casearch ofArchPPC->II32 _->II64 RcDouble ->FF64 _->panic"PPC.Instr.mkSpillInstr: no match"instr =casemakeImmediate W32True(off -delta )ofJust_->ST Nothing->STFAR -- pseudo instruction: 32 bit offsetsininstr fmt reg (AddrRegImm sp (ImmInt (off -delta )))ppc_mkLoadInstr::DynFlags->Reg -- register to load->Int-- current stack delta->Int-- spill slot to use->Instr ppc_mkLoadInstr dflags reg delta slot =letplatform =targetPlatformdflags off =spillSlotToOffset dflags slot arch =platformArchplatform inletfmt =casetargetClassOfReg platform reg ofRcInteger ->casearch ofArchPPC->II32 _->II64 RcDouble ->FF64 _->panic"PPC.Instr.mkLoadInstr: no match"instr =casemakeImmediate W32True(off -delta )ofJust_->LD Nothing->LDFAR -- pseudo instruction: 32 bit offsetsininstr fmt reg (AddrRegImm sp (ImmInt (off -delta )))-- | The size of a minimal stackframe header including minimal-- parameter save area.stackFrameHeaderSize::DynFlags->IntstackFrameHeaderSize dflags =caseplatformOSplatform ofOSAIX->24+8*4_->caseplatformArchplatform of-- header + parameter save areaArchPPC->64-- TODO: check ABI specArchPPC_64ELF_V1->48+8*8ArchPPC_64ELF_V2->32+8*8_->panic"PPC.stackFrameHeaderSize: not defined for this OS"whereplatform =targetPlatformdflags -- | The maximum number of bytes required to spill a register. PPC32-- has 32-bit GPRs and 64-bit FPRs, while PPC64 has 64-bit GPRs and-- 64-bit FPRs. So the maximum is 8 regardless of platforms unlike-- x86. Note that AltiVec's vector registers are 128-bit wide so we-- must not use this to spill them.spillSlotSize::IntspillSlotSize =8-- | The number of spill slots available without allocating more.maxSpillSlots::DynFlags->IntmaxSpillSlots dflags =((rESERVED_C_STACK_BYTESdflags -stackFrameHeaderSize dflags )`div`spillSlotSize )-1-- = 0 -- useful for testing allocMoreStack-- | The number of bytes that the stack pointer should be aligned-- to. This is 16 both on PPC32 and PPC64 ELF (see ELF processor-- specific supplements).stackAlign::IntstackAlign =16-- | Convert a spill slot number to a *byte* offset, with no sign.spillSlotToOffset::DynFlags->Int->IntspillSlotToOffset dflags slot =stackFrameHeaderSize dflags +spillSlotSize *slot ---------------------------------------------------------------------------------- | See if this instruction is telling us the current C stack deltappc_takeDeltaInstr::Instr ->MaybeIntppc_takeDeltaInstr instr =caseinstr ofDELTA i ->Justi _->Nothingppc_isMetaInstr::Instr ->Boolppc_isMetaInstr instr =caseinstr ofCOMMENT {}->TrueLDATA {}->TrueNEWBLOCK {}->TrueDELTA {}->True_->False-- | Copy the value in a register to another one.-- Must work for all register classes.ppc_mkRegRegMoveInstr::Reg ->Reg ->Instr ppc_mkRegRegMoveInstr src dst =MR dst src -- | Make an unconditional jump instruction.ppc_mkJumpInstr::BlockId ->[Instr ]ppc_mkJumpInstr id =[BCC ALWAYS id Nothing]-- | Take the source and destination from this reg -> reg move instruction-- or Nothing if it's not oneppc_takeRegRegMoveInstr::Instr ->Maybe(Reg ,Reg )ppc_takeRegRegMoveInstr (MR dst src )=Just(src ,dst )ppc_takeRegRegMoveInstr_=Nothing-- ------------------------------------------------------------------------------- Making far branches-- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too-- big, we have to work around this limitation.makeFarBranches::LabelMap CmmStatics ->[NatBasicBlock Instr ]->[NatBasicBlock Instr ]makeFarBranches info_env blocks |lastblockAddresses <nearLimit =blocks |otherwise=zipWithhandleBlock blockAddresses blocks whereblockAddresses =scanl(+)0$mapblockLen blocks blockLen (BasicBlock _instrs )=lengthinstrs handleBlock addr (BasicBlock id instrs )=BasicBlock id (zipWithmakeFar [addr ..]instrs )makeFar _(BCC ALWAYS tgt _)=BCC ALWAYS tgt NothingmakeFaraddr (BCC cond tgt p )|abs(addr -targetAddr )>=nearLimit =BCCFAR cond tgt p |otherwise=BCC cond tgt p whereJusttargetAddr =lookupUFMblockAddressMap tgt makeFar_other =other -- 8192 instructions are allowed; let's keep some distance, as-- we have a few pseudo-insns that are pretty-printed as-- multiple instructions, and it's just not worth the effort-- to calculate things exactlynearLimit =7000-mapSize info_env *maxRetInfoTableSizeW blockAddressMap =listToUFM$zip(mapblockId blocks )blockAddresses