Do not go into an infinite loop when pretty-printer finds a negative indent (Trac...

[ghc-hetmet.git] / compiler / ghci / ByteCodeItbls.lhs

diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index 12cd47f..887f637 100644 (file)
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -48,7 +48,7 @@ itblCode :: ItblPtr -> Ptr ()
 itblCode (ItblPtr ptr)
    = (castPtr ptr)
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-                 `plusPtr` (wORD_SIZE * 2)
+                 `plusPtr` (3 * wORD_SIZE)
 #endif
 
 type ItblEnv = NameEnv (Name, ItblPtr)
@@ -83,15 +83,9 @@ cONSTR = CONSTR
 -- Assumes constructors are numbered from zero, not one
 make_constr_itbls :: [DataCon] -> IO ItblEnv
 make_constr_itbls cons
-   | listLengthCmp cons 8 /= GT -- <= 8 elements in the list
-   = do is <- mapM mk_vecret_itbl (zip cons [0..])
-       return (mkItblEnv is)
-   | otherwise
    = do is <- mapM mk_dirret_itbl (zip cons [0..])
        return (mkItblEnv is)
      where
-        mk_vecret_itbl (dcon, conNo)
-           = mk_itbl dcon conNo (vecret_entry conNo)
         mk_dirret_itbl (dcon, conNo)
            = mk_itbl dcon conNo stg_interp_constr_entry
 
@@ -125,14 +119,11 @@ make_constr_itbls cons
                             }
                -- Make a piece of code to jump to "entry_label".
                -- This is the only arch-dependent bit.
-           -- addr <- newExec [itbl]
            addrCon <- newExec [conInfoTbl]
-           let addr = (castFunPtrToPtr addrCon) `plusPtr` 4 -- ToDo: remove magic number
                     --putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl))
                     --putStrLn ("# ptrs  of itbl is " ++ show ptrs)
                     --putStrLn ("# nptrs of itbl is " ++ show nptrs_really)
-           -- return (getName dcon, ItblPtr (castFunPtrToPtr addr))
-           return (getName dcon, ItblPtr addr)
+           return (getName dcon, ItblPtr (castFunPtrToPtr addrCon))
 
 
 -- Make code which causes a jump to the given address.  This is the
@@ -261,27 +252,9 @@ byte6 w = fromIntegral (w `shiftR` 48)
 byte7 w = fromIntegral (w `shiftR` 56)
 
 
-vecret_entry 0 = stg_interp_constr1_entry
-vecret_entry 1 = stg_interp_constr2_entry
-vecret_entry 2 = stg_interp_constr3_entry
-vecret_entry 3 = stg_interp_constr4_entry
-vecret_entry 4 = stg_interp_constr5_entry
-vecret_entry 5 = stg_interp_constr6_entry
-vecret_entry 6 = stg_interp_constr7_entry
-vecret_entry 7 = stg_interp_constr8_entry
-
 #ifndef __HADDOCK__
 -- entry point for direct returns for created constr itbls
 foreign import ccall "&stg_interp_constr_entry" stg_interp_constr_entry :: Ptr ()
--- and the 8 vectored ones
-foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr3_entry" stg_interp_constr3_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr4_entry" stg_interp_constr4_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr5_entry" stg_interp_constr5_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr6_entry" stg_interp_constr6_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr7_entry" stg_interp_constr7_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr8_entry" stg_interp_constr8_entry :: Ptr ()
 #endif