From 9dc6674250dd462fe0f46b916dbc7a4ed4b56a31 Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 9 Feb 2001 16:49:30 +0000 Subject: [PATCH] [project @ 2001-02-09 16:49:30 by sewardj] Generate sparc entry code for interpreted constructors. GHCi now is doing a pretty good impression of working correctly on sparcs. Dudeadacious! --- ghc/compiler/ghci/ByteCodeItbls.lhs | 177 +++++++++++++++++++++++++---------- 1 file changed, 129 insertions(+), 48 deletions(-) diff --git a/ghc/compiler/ghci/ByteCodeItbls.lhs b/ghc/compiler/ghci/ByteCodeItbls.lhs index a130dc3..2d517bb 100644 --- a/ghc/compiler/ghci/ByteCodeItbls.lhs +++ b/ghc/compiler/ghci/ByteCodeItbls.lhs @@ -91,22 +91,17 @@ make_constr_itbls cons 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)) @@ -116,6 +111,67 @@ make_constr_itbls cons 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 @@ -150,11 +206,12 @@ foreign label "stg_interp_constr8_entry" stg_interp_constr8_entry :: Addr -- 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 } @@ -164,47 +221,71 @@ instance Storable StgInfoTable where = (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) -- 1.7.10.4