From aa162076d849966c54159410422a84c95e00340e Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 19 Oct 2001 10:02:50 +0000 Subject: [PATCH] [project @ 2001-10-19 10:02:50 by sewardj] merge from stable, revs: 1.191.4.1 +2 -2 fptools/ghc/compiler/Makefile 1.7.4.2 +38 -13 fptools/ghc/compiler/ghci/ByteCodeFFI.lhs 1.58.4.2 +4 -3 fptools/ghc/compiler/ghci/ByteCodeGen.lhs 1.25.4.1 +40 -10 fptools/ghc/compiler/ghci/ByteCodeLink.lhs Make the bytecode generation machinery print a helpful message if it has to give up due to lack of 64-bit support. Add various bits of supporting infrastructure for 64-bit values in the bytecode generator. Making it all work is beyond the scope of a patchlevel release, so these are unused right now. 1.25.4.2 +27 -7 fptools/ghc/compiler/ghci/ByteCodeLink.lhs Print a civilised and helpful error message if the bytecode linker should encounter a link failure. 1.58.4.3 +6 -8 fptools/ghc/compiler/ghci/ByteCodeGen.lhs 1.25.4.3 +1 -1 fptools/ghc/compiler/ghci/ByteCodeLink.lhs Also give civilised messages for interactive FFI link failures. 1.25.4.4 +2 -1 fptools/ghc/compiler/ghci/ByteCodeLink.lhs Refine the runtime-link-failure msg a bit. --- ghc/compiler/Makefile | 4 +- ghc/compiler/ghci/ByteCodeFFI.lhs | 51 +++++++++++++++------ ghc/compiler/ghci/ByteCodeGen.lhs | 21 +++++---- ghc/compiler/ghci/ByteCodeLink.lhs | 87 ++++++++++++++++++++++++++++-------- 4 files changed, 119 insertions(+), 44 deletions(-) diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index caa56bf..9d2d908 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.192 2001/10/12 14:27:28 rrt Exp $ +# $Id: Makefile,v 1.193 2001/10/19 10:02:50 sewardj Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk @@ -283,7 +283,7 @@ utils/PrimPacked_HC_OPTS = -fvia-C -monly-3-regs # ByteCodeItbls uses primops that the NCG doesn't support yet. ghci/ByteCodeItbls_HC_OPTS = -fvia-C -ghci/ByteCodeLink_HC_OPTS = -fvia-C +ghci/ByteCodeLink_HC_OPTS = -fvia-C -monly-3-regs # CSE interacts badly with top-level IORefs (reportedly in DriverState and # DriverMkDepend), causing some of them to be commoned up. We have a fix for diff --git a/ghc/compiler/ghci/ByteCodeFFI.lhs b/ghc/compiler/ghci/ByteCodeFFI.lhs index 89f212b..c6c9eef 100644 --- a/ghc/compiler/ghci/ByteCodeFFI.lhs +++ b/ghc/compiler/ghci/ByteCodeFFI.lhs @@ -4,7 +4,7 @@ \section[ByteCodeGen]{Generate machine-code sequences for foreign import} \begin{code} -module ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode ) where +module ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode, moan64 ) where #include "HsVersions.h" @@ -19,7 +19,8 @@ import Bits ( Bits(..), shiftR, shiftL ) import Word ( Word8, Word32 ) import Addr ( Addr(..), writeWord8OffAddr ) import Foreign ( Ptr(..), mallocBytes ) -import IOExts ( trace ) +import IOExts ( trace, unsafePerformIO ) +import IO ( hPutStrLn, stderr ) \end{code} @@ -67,6 +68,21 @@ sendBytesToMallocville bytes \begin{code} +moan64 :: String -> SDoc -> a +moan64 msg pp_rep + = unsafePerformIO ( + hPutStrLn stderr ( + "\nGHCi's bytecode generation machinery can't handle 64-bit\n" ++ + "code properly yet. You can work around this for the time being\n" ++ + "by compiling this module and all those it imports to object code,\n" ++ + "and re-starting your GHCi session. The panic below contains information,\n" ++ + "intended for the GHC implementors, about the exact place where GHC gave up.\n" + ) + ) + `seq` + pprPanic msg pp_rep + + -- For sparc_TARGET_ARCH, i386_TARGET_ARCH, etc. #include "nativeGen/NCG.h" @@ -141,6 +157,8 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps = [0x81, 0xC4] ++ lit32 lit movl_eax_offesimem offB -- movl %eax, offB(%esi) = [0x89, 0x86] ++ lit32 offB + movl_edx_offesimem offB -- movl %edx, offB(%esi) + = [0x89, 0x96] ++ lit32 offB ret -- ret = [0xC3] fstpl_offesimem offB -- fstpl offB(%esi) @@ -256,16 +274,23 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps or fstps 4(%esi) -} - ++ case r_rep of - CharRep -> movl_eax_offesimem 4 - IntRep -> movl_eax_offesimem 4 - WordRep -> movl_eax_offesimem 4 - AddrRep -> movl_eax_offesimem 4 - DoubleRep -> fstpl_offesimem 4 - FloatRep -> fstps_offesimem 4 + ++ let i32 = movl_eax_offesimem 4 + i64 = movl_eax_offesimem 4 ++ movl_edx_offesimem 8 + f32 = fstps_offesimem 4 + f64 = fstpl_offesimem 4 + in + case r_rep of + CharRep -> i32 + IntRep -> i32 + WordRep -> i32 + AddrRep -> i32 + DoubleRep -> f64 + FloatRep -> f32 + -- Word64Rep -> i64 + -- Int64Rep -> i64 VoidRep -> [] - other -> pprPanic "ByteCodeFFI.mkMarshalCode_wrk(x86)" - (ppr r_rep) + other -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(x86)" + (ppr r_rep) {- Restore all the pushed regs and go home. @@ -463,8 +488,8 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps DoubleRep -> f64 FloatRep -> f32 VoidRep -> [] - other -> pprPanic "ByteCodeFFI.mkMarshalCode_wrk(sparc)" - (ppr r_rep) + other -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(sparc)" + (ppr r_rep) ++ [mkRET, mkRESTORE_TRIVIAL] -- this is in the delay slot of the RET diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs index 170a85c..12b6f29 100644 --- a/ghc/compiler/ghci/ByteCodeGen.lhs +++ b/ghc/compiler/ghci/ByteCodeGen.lhs @@ -48,9 +48,9 @@ import Constants ( wORD_SIZE ) import ByteCodeInstr ( BCInstr(..), ProtoBCO(..), nameOfProtoBCO, bciStackUse ) import ByteCodeItbls ( ItblEnv, mkITbls ) import ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO, - ClosureEnv, HValue, filterNameMap, + ClosureEnv, HValue, filterNameMap, linkFail, iNTERP_STACK_CHECK_THRESH ) -import ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode ) +import ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode, moan64 ) import Linker ( lookupSymbol ) import List ( intersperse, sortBy, zip4 ) @@ -765,16 +765,14 @@ generateCCall d0 s p ccall_spec@(CCallSpec target cconv safety) fn args_r_to_l DynamicTarget -> returnBc (False, panic "ByteCodeGen.generateCCall(dyn)") StaticTarget target - -> ioToBc (lookupSymbol (_UNPK_ target)) `thenBc` \res -> + -> let sym_to_find = _UNPK_ target in + ioToBc (lookupSymbol sym_to_find) `thenBc` \res -> case res of Just aa -> case aa of Ptr a# -> returnBc (True, A# a#) - Nothing -> returnBc invalid + Nothing -> ioToBc (linkFail "ByteCodeGen.generateCCall" + sym_to_find) CasmTarget _ - -> returnBc invalid - where - invalid = pprPanic ("ByteCodeGen.generateCCall: unfindable " - ++ "symbol or otherwise invalid target") - (ppr ccall_spec) + -> pprPanic "ByteCodeGen.generateCCall: casm" (ppr ccall_spec) in get_target_info `thenBc` \ (is_static, static_target_addr) -> let @@ -840,10 +838,11 @@ mkDummyLiteral pr = case pr of CharRep -> MachChar 0 IntRep -> MachInt 0 + WordRep -> MachWord 0 DoubleRep -> MachDouble 0 FloatRep -> MachFloat 0 AddrRep | taggedSizeW AddrRep == taggedSizeW WordRep -> MachWord 0 - _ -> pprPanic "mkDummyLiteral" (ppr pr) + _ -> moan64 "mkDummyLiteral" (ppr pr) -- Convert (eg) @@ -980,7 +979,7 @@ mkUnpackCode vars d p | npr `elem` [IntRep, WordRep, FloatRep, DoubleRep, CharRep, AddrRep] = approved | otherwise - = pprPanic "ByteCodeGen.mkUnpackCode" (ppr npr) + = moan64 "ByteCodeGen.mkUnpackCode" (ppr npr) where approved = UPK_TAG usizeW (off_h-usizeW) off_s `consOL` theRest theRest = do_nptrs (off_h-usizeW) (off_s + tsizeW) nprs diff --git a/ghc/compiler/ghci/ByteCodeLink.lhs b/ghc/compiler/ghci/ByteCodeLink.lhs index 73ccb95..1e9e10f 100644 --- a/ghc/compiler/ghci/ByteCodeLink.lhs +++ b/ghc/compiler/ghci/ByteCodeLink.lhs @@ -9,7 +9,7 @@ module ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO, ClosureEnv, HValue, filterNameMap, - linkIModules, linkIExpr, + linkIModules, linkIExpr, linkFail, iNTERP_STACK_CHECK_THRESH ) where @@ -37,6 +37,7 @@ import Monad ( when, foldM ) import ST ( runST ) import IArray ( array ) import MArray ( castSTUArray, + newInt64Array, writeInt64Array, newFloatArray, writeFloatArray, newDoubleArray, writeDoubleArray, newIntArray, writeIntArray, @@ -51,9 +52,12 @@ import PrelBase ( Int(..) ) import PrelGHC ( BCO#, newBCO#, unsafeCoerce#, ByteArray#, Array#, addrToHValue#, mkApUpd0# ) import IOExts ( fixIO ) +import Exception ( throwDyn ) +import Panic ( GhcException(..) ) import PrelArr ( Array(..) ) import ArrayBase ( UArray(..) ) import PrelIOBase ( IO(..) ) +import Int ( Int64 ) \end{code} @@ -319,6 +323,11 @@ mkBits findLabel st proto_insns st_l1 <- addListToSS st_l0 ws return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0)) + int64 (st_i0,st_l0,st_p0,st_I0) i + = do let ws = mkLitI64 i + st_l1 <- addListToSS st_l0 ws + return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0)) + addr (st_i0,st_l0,st_p0,st_I0) a = do let ws = mkLitA a st_l1 <- addListToSS st_l0 ws @@ -332,12 +341,14 @@ mkBits findLabel st proto_insns = do st_I1 <- addToSS st_I0 (getName dcon) return (sizeSS st_I0, (st_i0,st_l0,st_p0,st_I1)) - literal st (MachWord w) = int st (fromIntegral w) - literal st (MachInt j) = int st (fromIntegral j) - literal st (MachFloat r) = float st (fromRational r) - literal st (MachDouble r) = double st (fromRational r) - literal st (MachChar c) = int st c - literal st other = pprPanic "ByteCodeLink.literal" (ppr other) + literal st (MachWord w) = int st (fromIntegral w) + literal st (MachInt j) = int st (fromIntegral j) + literal st (MachFloat r) = float st (fromRational r) + literal st (MachDouble r) = double st (fromRational r) + literal st (MachChar c) = int st c + literal st (MachInt64 ii) = int64 st (fromIntegral ii) + literal st (MachWord64 ii) = int64 st (fromIntegral ii) + literal st other = pprPanic "ByteCodeLink.literal" (ppr other) ctoi_itbl st pk = addr st ret_itbl_addr @@ -361,6 +372,7 @@ mkBits findLabel st proto_insns = case pk of CharRep -> stg_gc_unbx_r1_ret_info IntRep -> stg_gc_unbx_r1_ret_info + WordRep -> stg_gc_unbx_r1_ret_info AddrRep -> stg_gc_unbx_r1_ret_info FloatRep -> stg_gc_f1_ret_info DoubleRep -> stg_gc_d1_ret_info @@ -415,10 +427,11 @@ instrSize16s instr -- Make lists of host-sized words for literals, so that when the -- words are placed in memory at increasing addresses, the -- bit pattern is correct for the host's word size and endianness. -mkLitI :: Int -> [Word] -mkLitF :: Float -> [Word] -mkLitD :: Double -> [Word] -mkLitA :: Addr -> [Word] +mkLitI :: Int -> [Word] +mkLitF :: Float -> [Word] +mkLitD :: Double -> [Word] +mkLitA :: Addr -> [Word] +mkLitI64 :: Int64 -> [Word] mkLitF f = runST (do @@ -448,6 +461,25 @@ mkLitD d return [w0] ) +mkLitI64 ii + | wORD_SIZE == 4 + = runST (do + arr <- newInt64Array ((0::Int),1) + writeInt64Array arr 0 ii + d_arr <- castSTUArray arr + w0 <- readWordArray d_arr 0 + w1 <- readWordArray d_arr 1 + return [w0,w1] + ) + | wORD_SIZE == 8 + = runST (do + arr <- newInt64Array ((0::Int),0) + writeInt64Array arr 0 ii + d_arr <- castSTUArray arr + w0 <- readWordArray d_arr 0 + return [w0] + ) + mkLitI i = runST (do arr <- newIntArray ((0::Int),0) @@ -536,20 +568,22 @@ newBCO a b c d lookupCE :: ClosureEnv -> Either Name PrimOp -> IO HValue lookupCE ce (Right primop) - = do m <- lookupSymbol (primopToCLabel primop "closure") + = do let sym_to_find = primopToCLabel primop "closure" + m <- lookupSymbol sym_to_find case m of Just (Ptr addr) -> case addrToHValue# addr of (# hval #) -> return hval - Nothing -> pprPanic "ByteCodeLink.lookupCE(primop)" (ppr primop) + Nothing -> linkFail "ByteCodeLink.lookupCE(primop)" sym_to_find lookupCE ce (Left nm) = case lookupFM ce nm of Just aa -> return aa Nothing - -> do m <- lookupSymbol (nameToCLabel nm "closure") + -> do let sym_to_find = nameToCLabel nm "closure" + m <- lookupSymbol sym_to_find case m of Just (Ptr addr) -> case addrToHValue# addr of (# hval #) -> return hval - Nothing -> pprPanic "ByteCodeLink.lookupCE" (ppr nm) + Nothing -> linkFail "ByteCodeLink.lookupCE" sym_to_find lookupIE :: ItblEnv -> Name -> IO (Ptr a) lookupIE ie con_nm @@ -557,15 +591,32 @@ lookupIE ie con_nm Just (Ptr a) -> return (Ptr a) Nothing -> do -- try looking up in the object files. - m <- lookupSymbol (nameToCLabel con_nm "con_info") + let sym_to_find1 = nameToCLabel con_nm "con_info" + m <- lookupSymbol sym_to_find1 case m of Just addr -> return addr Nothing -> do -- perhaps a nullary constructor? - n <- lookupSymbol (nameToCLabel con_nm "static_info") + let sym_to_find2 = nameToCLabel con_nm "static_info" + n <- lookupSymbol sym_to_find2 case n of Just addr -> return addr - Nothing -> pprPanic "ByteCodeLink.lookupIE" (ppr con_nm) + Nothing -> linkFail "ByteCodeLink.lookupIE" + (sym_to_find1 ++ " or " ++ sym_to_find2) + +linkFail :: String -> String -> IO a +linkFail who what + = throwDyn (ProgramError ( + "\nDuring interactive linking, GHCi couldn't find the following symbol:\n" ++ + " " ++ what ++ "\n" ++ + "This may be due to you not asking GHCi to load extra object files,\n" ++ + "archives or DLLs needed by your current session. Restart GHCi, specifying\n" ++ + "the missing library using the -L/path/to/object/dir and -lmissinglibname\n" ++ + "flags, or simply by naming the relevant files on the GHCi command line.\n" ++ + "Alternatively, this link failure might indicate a bug in GHCi.\n" ++ + "If you suspect the latter, please send a bug report to:\n" ++ + " glasgow-haskell-bugs@haskell.org\n" + )) -- HACKS!!! ToDo: cleaner nameToCLabel :: Name -> String{-suffix-} -> String -- 1.7.10.4