code0 = fromIntegral code0, code1 = fromIntegral code1,
code2 = fromIntegral code2, code3 = fromIntegral code3,
code4 = fromIntegral code4, code5 = fromIntegral code5,
- code6 = fromIntegral code6, code7 = fromIntegral code7
+ code6 = fromIntegral code6, code7 = fromIntegral code7,
+ code8 = fromIntegral code8, code9 = fromIntegral code9,
+ codeA = fromIntegral codeA, codeB = fromIntegral codeB,
+ codeC = fromIntegral codeC, codeD = fromIntegral codeD,
+ codeE = fromIntegral codeE, codeF = fromIntegral codeF
}
-- Make a piece of code to jump to "entry_label".
-- This is the only arch-dependent bit.
- -- On x86, if entry_label has an address 0xWWXXYYZZ,
- -- emit movl $0xWWXXYYZZ,%eax ; jmp *%eax
- -- which is
- -- B8 ZZ YY XX WW FF E0
- (code0,code1,code2,code3,code4,code5,code6,code7)
- = (0xB8, byte 0 entry_addr_w, byte 1 entry_addr_w,
- byte 2 entry_addr_w, byte 3 entry_addr_w,
- 0xFF, 0xE0,
- 0x90 {-nop-})
-
- entry_addr_w :: Word32
- entry_addr_w = fromIntegral (addrToInt entry_addr)
+ [code0,code1,code2,code3,code4,code5,code6,code7,
+ code8,code9,codeA,codeB,codeC,codeD,codeE,codeF]
+ = mkJumpToAddr entry_addr
in
do addr <- malloc
--putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl))
return (getName dcon, addr `plusPtr` 8)
+-- Make code which causes a jump to the given address. This is the
+-- only arch-dependent bit of the itbl story. The returned list is
+-- 16 elements long, since on sparc 4 words (i.e. 4 insns) are needed.
+
+-- For sparc_TARGET_ARCH, i386_TARGET_ARCH, etc.
+#include "nativeGen/NCG.h"
+
+mkJumpToAddr :: Addr -> [Word8]
+
+#if sparc_TARGET_ARCH
+-- After some consideration, we'll try this, where
+-- 0x55555555 stands in for the address to jump to.
+-- According to ghc/includes/MachRegs.h, %g3 is very
+-- likely indeed to be baggable.
+--
+-- 0000 07155555 sethi %hi(0x55555555), %g3
+-- 0004 8610E155 or %g3, %lo(0x55555555), %g3
+-- 0008 81C0C000 jmp %g3
+-- 000c 01000000 nop
+
+mkJumpToAddr a
+ = let w32 = fromIntegral (addrToInt a)
+ insn1 = 0x07000000 .|. (hi22 w32)
+ insn2 = 0x8610E000 .|. (lo10 w32)
+ insn3 = 0x81C0C000
+ insn4 = 0x01000000
+
+ -- big-endianly ...
+ w2bytes :: Word32 -> [Word8]
+ w2bytes w
+ = map fromIntegral [byte 3 w, byte 2 w, byte 1 w, byte 0 w]
+
+ hi22, lo10 :: Word32 -> Word32
+ lo10 x = x .&. 0x3FF
+ hi22 x = (x `shiftR` 10) .&. 0x3FFFF
+
+ insnBytes
+ = concat (map w2bytes [insn1, insn2, insn3, insn4])
+ in
+ insnBytes
+#endif
+
+#if i386_TARGET_ARCH
+-- Let the address to jump to be 0xWWXXYYZZ.
+-- Generate movl $0xWWXXYYZZ,%eax ; jmp *%eax
+-- which is
+-- B8 ZZ YY XX WW FF E0
+mkJumpToAddr a
+ = let w32 = fromIntegral (addrToInt a)
+ insnBytes
+ = take 16 (
+ [0xB8, byte 0 w32, byte 1 w32,
+ byte 2 w32, byte 3 w32,
+ 0xFF, 0xE0]
+ ++ let nops = 0x90 : nops in nops
+ )
+ in
+ insnBytes
+#endif
+
+
byte :: Int -> Word32 -> Word32
byte 0 w = w .&. 0xFF
byte 1 w = (w `shiftR` 8) .&. 0xFF
-- Ultra-minimalist version specially for constructors
data StgInfoTable = StgInfoTable {
- ptrs :: Word16,
- nptrs :: Word16,
+ ptrs :: Word16,
+ nptrs :: Word16,
srtlen :: Word16,
- tipe :: Word16,
- code0, code1, code2, code3, code4, code5, code6, code7 :: Word8
+ tipe :: Word16,
+ code0, code1, code2, code3, code4, code5, code6, code7,
+ code8, code9, codeA, codeB, codeC, codeD, codeE, codeF :: Word8
}
= (sum . map (\f -> f itbl))
[fieldSz ptrs, fieldSz nptrs, fieldSz srtlen, fieldSz tipe,
fieldSz code0, fieldSz code1, fieldSz code2, fieldSz code3,
- fieldSz code4, fieldSz code5, fieldSz code6, fieldSz code7]
+ fieldSz code4, fieldSz code5, fieldSz code6, fieldSz code7,
+ fieldSz code8, fieldSz code9, fieldSz codeA, fieldSz codeB,
+ fieldSz codeC, fieldSz codeD, fieldSz codeE, fieldSz codeF]
alignment itbl
= (sum . map (\f -> f itbl))
[fieldAl ptrs, fieldAl nptrs, fieldAl srtlen, fieldAl tipe,
fieldAl code0, fieldAl code1, fieldAl code2, fieldAl code3,
- fieldAl code4, fieldAl code5, fieldAl code6, fieldAl code7]
+ fieldAl code4, fieldAl code5, fieldAl code6, fieldAl code7,
+ fieldAl code8, fieldAl code9, fieldAl codeA, fieldAl codeB,
+ fieldAl codeC, fieldAl codeD, fieldAl codeE, fieldAl codeF]
poke a0 itbl
- = do a1 <- store (ptrs itbl) (castPtr a0)
- a2 <- store (nptrs itbl) a1
- a3 <- store (tipe itbl) a2
- a4 <- store (srtlen itbl) a3
- a5 <- store (code0 itbl) a4
- a6 <- store (code1 itbl) a5
- a7 <- store (code2 itbl) a6
- a8 <- store (code3 itbl) a7
- a9 <- store (code4 itbl) a8
- aA <- store (code5 itbl) a9
- aB <- store (code6 itbl) aA
- aC <- store (code7 itbl) aB
+ = do a1 <- store (ptrs itbl) (castPtr a0)
+ a2 <- store (nptrs itbl) a1
+ a3 <- store (tipe itbl) a2
+ a4 <- store (srtlen itbl) a3
+ a5 <- store (code0 itbl) a4
+ a6 <- store (code1 itbl) a5
+ a7 <- store (code2 itbl) a6
+ a8 <- store (code3 itbl) a7
+ a9 <- store (code4 itbl) a8
+ aA <- store (code5 itbl) a9
+ aB <- store (code6 itbl) aA
+ aC <- store (code7 itbl) aB
+ aD <- store (code8 itbl) aC
+ aE <- store (code9 itbl) aD
+ aF <- store (codeA itbl) aE
+ a10 <- store (codeB itbl) aF
+ a11 <- store (codeC itbl) a10
+ a12 <- store (codeD itbl) a11
+ a13 <- store (codeE itbl) a12
+ a14 <- store (codeF itbl) a13
return ()
peek a0
- = do (a1,ptrs) <- load (castPtr a0)
- (a2,nptrs) <- load a1
- (a3,tipe) <- load a2
- (a4,srtlen) <- load a3
- (a5,code0) <- load a4
- (a6,code1) <- load a5
- (a7,code2) <- load a6
- (a8,code3) <- load a7
- (a9,code4) <- load a8
- (aA,code5) <- load a9
- (aB,code6) <- load aA
- (aC,code7) <- load aB
- return StgInfoTable { ptrs = ptrs, nptrs = nptrs,
- srtlen = srtlen, tipe = tipe,
- code0 = code0, code1 = code1, code2 = code2,
- code3 = code3, code4 = code4, code5 = code5,
- code6 = code6, code7 = code7 }
+ = do (a1, ptrs) <- load (castPtr a0)
+ (a2, nptrs) <- load a1
+ (a3, tipe) <- load a2
+ (a4, srtlen) <- load a3
+ (a5, code0) <- load a4
+ (a6, code1) <- load a5
+ (a7, code2) <- load a6
+ (a8, code3) <- load a7
+ (a9, code4) <- load a8
+ (aA, code5) <- load a9
+ (aB, code6) <- load aA
+ (aC, code7) <- load aB
+ (aD, code8) <- load aC
+ (aE, code9) <- load aD
+ (aF, codeA) <- load aE
+ (a10,codeB) <- load aF
+ (a11,codeC) <- load a10
+ (a12,codeD) <- load a11
+ (a13,codeE) <- load a12
+ (a14,codeF) <- load a13
+ return
+ StgInfoTable {
+ ptrs = ptrs, nptrs = nptrs,
+ srtlen = srtlen, tipe = tipe,
+ code0 = code0, code1 = code1, code2 = code2, code3 = code3,
+ code4 = code4, code5 = code5, code6 = code6, code7 = code7,
+ code8 = code8, code9 = code9, codeA = codeA, codeB = codeB,
+ codeC = codeC, codeD = codeD, codeE = codeE, codeF = codeF
+ }
fieldSz :: (Storable a, Storable b) => (a -> b) -> a -> Int
fieldSz sel x = sizeOf (sel x)
projects / ghc-hetmet.git / commitdiff