X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachMisc.lhs;h=4ec74c378c83e2d007c601802d52e717112babe0;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=f3757ee60ebdb26242927de37925c2df0ec42c3e;hpb=c4640edc78102f7dbe374dab8febefb6c94827a6;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index f3757ee..4ec74c3 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -1,25 +1,19 @@ % -% (c) The AQUA Project, Glasgow University, 1993-1996 +% (c) The AQUA Project, Glasgow University, 1993-1998 % \section[MachMisc]{Description of various machine-specific things} \begin{code} -#include "HsVersions.h" #include "nativeGen/NCG.h" module MachMisc ( - fixedHdrSizeInWords, varHdrSizeInWords, - charLikeSize, intLikeSize, mutHS, dataHS, foHS, sizeOf, primRepToSize, eXTRA_STK_ARGS_HERE, volatileSaves, volatileRestores, - storageMgrInfo, smCAFlist, smOldLim, smOldMutables, - smStablePtrTable, - targetMaxDouble, targetMaxInt, targetMinDouble, targetMinInt, underscorePrefix, @@ -41,47 +35,33 @@ module MachMisc ( #endif ) where -IMPORT_1_3(Char(isDigit)) -IMP_Ubiq(){-uitous-} - -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201 -IMPORT_DELOOPER(AbsCLoop) ( fixedHdrSizeInWords, varHdrSizeInWords ) -- paranoia -IMPORT_DELOOPER(NcgLoop) ( underscorePrefix, fmtAsmLbl ) -- paranoia -#endif +#include "HsVersions.h" +--#include "config.h" import AbsCSyn ( MagicId(..) ) import AbsCUtils ( magicIdPrimRep ) import CLabel ( CLabel ) -import CmdLineOpts ( opt_SccProfilingOn ) -import Literal ( mkMachInt, Literal(..) ) +import Const ( mkMachInt, Literal(..) ) import MachRegs ( stgReg, callerSaves, RegLoc(..), - Imm(..), Reg(..), Address(..) + Imm(..), Reg(..), + MachRegsAddr(..) ) - -import OrdList ( OrdList ) import PrimRep ( PrimRep(..) ) -import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) ) -import Stix ( StixTree(..), StixReg(..), sStLitLbl, - CodeSegment - ) +import SMRep ( SMRep(..) ) +import Stix ( StixTree(..), StixReg(..), CodeSegment ) import Util ( panic ) +import Char ( isDigit ) +import GlaExts ( word2Int#, int2Word#, shiftRL#, and#, (/=#) ) \end{code} \begin{code} -underscorePrefix :: Bool -- leading underscore on labels? - -underscorePrefix - = IF_ARCH_alpha(False - ,{-else-} IF_ARCH_i386( - IF_OS_linuxaout(True - , IF_OS_freebsd(True - , IF_OS_cygwin32(True - , IF_OS_bsdi(True - , {-otherwise-} False))) - ) - ,{-else-}IF_ARCH_sparc( - IF_OS_sunos4(True, {-otherwise-} False) - ,))) +underscorePrefix :: Bool -- leading underscore on assembler labels? + +#ifdef LEADING_UNDERSCORE +underscorePrefix = True +#else +underscorePrefix = False +#endif --------------------------- fmtAsmLbl :: String -> String -- for formatting labels @@ -147,71 +127,6 @@ eXTRA_STK_ARGS_HERE = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23,???))) \end{code} -% ---------------------------------------------------------------- - -@fixedHdrSizeInWords@ and @varHdrSizeInWords@: these are not dependent -on target architecture. -\begin{code} -fixedHdrSizeInWords :: Int - -fixedHdrSizeInWords - = 1{-info ptr-} + profFHS + parFHS + tickyFHS - -- obviously, we aren't taking non-sequential too seriously yet - where - profFHS = if opt_SccProfilingOn then 1 else 0 - parFHS = {-if PAR or GRAN then 1 else-} 0 - tickyFHS = {-if ticky ... then 1 else-} 0 - -varHdrSizeInWords :: SMRep -> Int{-in words-} - -varHdrSizeInWords sm - = case sm of - StaticRep _ _ -> 0 - SpecialisedRep _ _ _ _ -> 0 - GenericRep _ _ _ -> 0 - BigTupleRep _ -> 1 - MuTupleRep _ -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -} - DataRep _ -> 1 - DynamicRep -> 2 - BlackHoleRep -> 0 - PhantomRep -> panic "MachMisc.varHdrSizeInWords:phantom" -\end{code} - -% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Static closure sizes: -\begin{code} -charLikeSize, intLikeSize :: Int - -charLikeSize = blahLikeSize CharLikeRep -intLikeSize = blahLikeSize IntLikeRep - -blahLikeSize blah - = fromInteger (sizeOf PtrRep) - * (fixedHdrSizeInWords + varHdrSizeInWords blahLikeRep + 1) - where - blahLikeRep = SpecialisedRep blah 0 1 SMNormalForm - --------- -mutHS, dataHS, foHS :: StixTree - -mutHS = blah_hs (MuTupleRep 0) -dataHS = blah_hs (DataRep 0) - -{- Semi-hack: to avoid introducing ForeignObjRep, - we hard-code the VHS for ForeignObj here. --} -foHS - = StInt (toInteger words) - where - words = fixedHdrSizeInWords + 1{-FOREIGN_VHS-} - -blah_hs blah - = StInt (toInteger words) - where - words = fixedHdrSizeInWords + varHdrSizeInWords blah -\end{code} - % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Size of a @PrimRep@, in bytes. @@ -238,8 +153,8 @@ constants. \begin{code} volatileSaves, volatileRestores :: [MagicId] -> [StixTree] -save_cands = [BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg] -restore_cands = save_cands ++ [StkStubReg,StdUpdRetVecReg] +save_cands = [BaseReg,Sp,Su,SpLim,Hp,HpLim] +restore_cands = save_cands volatileSaves vols = map save ((filter callerSaves) (save_cands ++ vols)) @@ -270,27 +185,12 @@ ToDo: Fix!(JSM) \begin{code} targetMinDouble = MachDouble (-1.7976931348623157e+308) targetMaxDouble = MachDouble (1.7976931348623157e+308) -targetMinInt = mkMachInt (-2147483647) +targetMinInt = mkMachInt (-2147483648) targetMaxInt = mkMachInt 2147483647 \end{code} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Storage manager nonsense. Note that the indices are dependent on -the definition of the smInfo structure in SMinterface.lh - -\begin{code} -storageMgrInfo, smCAFlist, smOldMutables, smOldLim :: StixTree - -storageMgrInfo = sStLitLbl SLIT("StorageMgrInfo") -smCAFlist = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_CAFLIST)) -smOldMutables = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDMUTABLES)) -smOldLim = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDLIM)) -smStablePtrTable = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_STABLEPOINTERTABLE)) -\end{code} - -% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This algorithm for determining the $\log_2$ of exact powers of 2 comes from GCC. It requires bit manipulation primitives, and we use GHC extensions. Tough. @@ -298,7 +198,6 @@ extensions. Tough. \begin{code} w2i x = word2Int# x i2w x = int2Word# x -i2w_s x = (x::Int#) exactLog2 :: Integer -> Maybe Integer exactLog2 x @@ -312,10 +211,10 @@ exactLog2 x Just (toInteger (I# (pow2 x#))) } where - shiftr x y = shiftRA# x y + shiftr x y = shiftRL# x y pow2 x# | x# ==# 1# = 0# - | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` i2w_s 1#)) + | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` 1#)) \end{code} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -418,8 +317,9 @@ primRepToSize FloatRep = IF_ARCH_alpha( TF, IF_ARCH_i386( F, IF_ARCH_sparc( primRepToSize DoubleRep = IF_ARCH_alpha( TF, IF_ARCH_i386( DF,IF_ARCH_sparc( DF,))) primRepToSize ArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) primRepToSize ByteArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) +primRepToSize WeakPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) +primRepToSize ForeignObjRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) primRepToSize StablePtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) -primRepToSize ForeignObjRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) \end{code} %************************************************************************ @@ -449,12 +349,12 @@ data Instr -- Loads and stores. - | LD Size Reg Address -- size, dst, src - | LDA Reg Address -- dst, src - | LDAH Reg Address -- dst, src - | LDGP Reg Address -- dst, src + | LD Size Reg MachRegsAddr -- size, dst, src + | LDA Reg MachRegsAddr -- dst, src + | LDAH Reg MachRegsAddr -- dst, src + | LDGP Reg MachRegsAddr -- dst, src | LDI Size Reg Imm -- size, dst, src - | ST Size Reg Address -- size, src, dst + | ST Size Reg MachRegsAddr -- size, src, dst -- Int Arithmetic. @@ -509,9 +409,9 @@ data Instr | BI Cond Reg Imm | BF Cond Reg Imm | BR Imm - | JMP Reg Address Int + | JMP Reg MachRegsAddr Int | BSR Imm Int - | JSR Reg Address Int + | JSR Reg MachRegsAddr Int -- Alpha-specific pseudo-ops. @@ -572,25 +472,25 @@ data RI | FABS | FADD Size Operand -- src | FADDP - | FIADD Size Address -- src + | FIADD Size MachRegsAddr -- src | FCHS | FCOM Size Operand -- src | FCOS | FDIV Size Operand -- src | FDIVP - | FIDIV Size Address -- src + | FIDIV Size MachRegsAddr -- src | FDIVR Size Operand -- src | FDIVRP - | FIDIVR Size Address -- src - | FICOM Size Address -- src - | FILD Size Address Reg -- src, dst - | FIST Size Address -- dst + | FIDIVR Size MachRegsAddr -- src + | FICOM Size MachRegsAddr -- src + | FILD Size MachRegsAddr Reg -- src, dst + | FIST Size MachRegsAddr -- dst | FLD Size Operand -- src | FLD1 | FLDZ | FMUL Size Operand -- src | FMULP - | FIMUL Size Address -- src + | FIMUL Size MachRegsAddr -- src | FRNDINT | FSIN | FSQRT @@ -598,10 +498,10 @@ data RI | FSTP Size Operand -- dst | FSUB Size Operand -- src | FSUBP - | FISUB Size Address -- src + | FISUB Size MachRegsAddr -- src | FSUBR Size Operand -- src | FSUBRP - | FISUBR Size Address -- src + | FISUBR Size MachRegsAddr -- src | FTST | FCOMP Size Operand -- src | FUCOMPP @@ -633,7 +533,7 @@ data RI data Operand = OpReg Reg -- register | OpImm Imm -- immediate value - | OpAddr Address -- memory reference + | OpAddr MachRegsAddr -- memory reference #endif {- i386_TARGET_ARCH -} \end{code} @@ -645,8 +545,8 @@ data Operand -- Loads and stores. - | LD Size Address Reg -- size, src, dst - | ST Size Reg Address -- size, src, dst + | LD Size MachRegsAddr Reg -- size, src, dst + | ST Size Reg MachRegsAddr -- size, src, dst -- Int Arithmetic. @@ -688,7 +588,7 @@ data Operand | BI Cond Bool Imm -- cond, annul?, target | BF Cond Bool Imm -- cond, annul?, target - | JMP Address -- target + | JMP MachRegsAddr -- target | CALL Imm Int Bool -- target, args, terminal data RI = RIReg Reg