Making the LLVM backend working for variant 99.

Pipeline is working, using OldIO. (No support for exceptions)
Hello world compiles

EHC/SVNREVISION

@@ -1 +1 @@
-2088:2089M
+2092:2093M

EHC/ehclib/base/Prelude.hs

@@ -26,7 +26,7 @@ module Prelude
   , module UHC.Show
   , module UHC.Read
   , module UHC.Run
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
   , module UHC.OldIO
 #else
   , module System.IO
@@ -69,13 +69,13 @@ import UHC.Show
 import UHC.Read
 import UHC.IOBase
   ( IOError, ioError, userError, catch, unsafePerformIO
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
   , FilePath
 #endif
   )
 import UHC.Run
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 import UHC.OldIO
 #else
 import System.IO

EHC/ehclib/uhcbase/UHC/Base.chs

@@ -58,7 +58,7 @@ module UHC.Base   -- adapted from the Hugs prelude
     AsyncException(..),
     IOException       ,
     ExitCode      (..),
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
     forceString,
 #else
     throw,
@@ -188,7 +188,7 @@ foreign import prim "primUnsafeId" unsafeCoerce :: forall a b . a -> b
 -- error, undefined
 ----------------------------------------------------------------
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 forceString :: String -> String
 forceString s = stringSum s `seq` s
@@ -216,15 +216,13 @@ undefined       = error "Prelude.undefined"
 -- Throw exception
 ----------------------------------------------------------------
 
-#ifdef __UHC_TARGET_C__
--- defined in UHC.OldException, on top of error because exceptions are not implemented, and show of exc is needed.
-#else
-
+#ifdef __UHC_TARGET_BC__
 foreign import prim primThrowException :: forall a x . SomeException' x -> a
 
 throw :: SomeException' x -> a
 throw e = primThrowException e
-
+#else
+-- defined in UHC.OldException, on top of error because exceptions are not implemented, and show of exc is needed.
 #endif
 
 ----------------------------------------------------------------
@@ -253,7 +251,7 @@ foreign import prim primByteArrayLength   :: ByteArray -> Int
 foreign import prim primByteArrayToString :: ByteArray -> String
 
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 foreign import prim packedStringToInteger :: PackedString -> Integer
 #else
 foreign import prim "primCStringToInteger" packedStringToInteger :: PackedString -> Integer
@@ -336,10 +334,10 @@ numericEnumFromThenTo n n' m = takeWhile p (numericEnumFromThen n n')
                                        | otherwise = (>= m + (n'-n)/2)
 
 iterate' :: (a -> a) -> a -> [a]        -- strict version of iterate
-#ifdef __UHC_TARGET_BC__
-iterate' f x = x : (letstrict fx = f x in iterate' f fx)
-#else
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 iterate' f x = x : (iterate' f $! f x)
+#else
+iterate' f x = x : (letstrict fx = f x in iterate' f fx)
 #endif
 
 --------------------------------------------------------------
@@ -861,7 +859,7 @@ foreign import prim primQuotInt      :: Int -> Int -> Int
 foreign import prim primRemInt       :: Int -> Int -> Int
 
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 instance Integral Int where
     divMod x y   = (primDivInt x y, primModInt x y)
@@ -904,7 +902,7 @@ instance Read Int where
     readsPrec p = readSigned readDec
 
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 {-
  This implementation fails for showInt minBound because in 2's complement arithmetic
  -minBound == maxBound+1 == minBound
@@ -965,7 +963,7 @@ foreign import prim primDivInteger           :: Integer -> Integer -> Integer
 foreign import prim primModInteger           :: Integer -> Integer -> Integer
 
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 instance Integral Integer where
     divMod x y  = (primDivInteger x y, primModInteger x y)
@@ -1010,7 +1008,7 @@ instance Enum Integer where
 
 
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 {-
  This implementation fails for showInt minBound because in 2's complement arithmetic
  -minBound == maxBound+1 == minBound
@@ -1556,7 +1554,7 @@ foldl f z (x:xs)  = foldl f (f z x) xs
 
 foldl'           :: (a -> b -> a) -> a -> [b] -> a
 foldl' f a []     = a
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 foldl' f a (x:xs) = (foldl' f $! f a x) xs
 #else
 foldl' f a (x:xs) = letstrict fax = f a x in foldl' f fax xs

EHC/ehclib/uhcbase/UHC/IOBase.chs

@@ -39,7 +39,7 @@ module UHC.IOBase
 
         -- Exception
     SomeException,
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
     throw,
 #endif
 
@@ -49,13 +49,13 @@ module UHC.IOBase
     try,
 
         -- Exception related: catch, throw
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 #else
     catchTracedException,
 #endif
     catch, catchException,
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
     FHandle,
 #endif
   )
@@ -372,13 +372,13 @@ data IOMode             -- alphabetical order of constructors required, assumed
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[99
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 data FHandle    -- opaque, contains FILE*
 #else
 data GBHandle   -- opaque, contains GB_Chan
 #endif
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 instance Eq FHandle where
     _ == _ = False
@@ -418,7 +418,7 @@ data Handle
         !(MVar Handle__)                -- The write side
 
   | OldHandle                            
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
         FHandle                        
 #else
         GBHandle                        
@@ -631,7 +631,7 @@ showException tag msg =
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[99
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 catch :: IO a -> (IOError -> IO a) -> IO a
 catch m h = m
@@ -665,7 +665,7 @@ catch m h = catchException m $ \e -> case e of
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[99
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 throw :: SomeException -> a
 throw e = error (show e)
@@ -679,7 +679,7 @@ throw e = error (show e)
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[99
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 ioError :: IOError -> IO a
 ioError = error "ioError"
 

EHC/ehclib/uhcbase/UHC/OldIO.chs

@@ -34,7 +34,7 @@ import UHC.IOBase
 -- I/O primitives and their wrapping in the I/O monad
 ----------------------------------------------------------------
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 foreign import prim primHClose        :: FHandle -> ()
 foreign import prim primHFlush        :: FHandle -> ()
 foreign import prim primHGetChar      :: FHandle -> Char
@@ -46,7 +46,7 @@ foreign import prim primHGetChar      :: Handle -> Char
 foreign import prim primHPutChar      :: Handle -> Char -> ()
 #endif
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 foreign import prim primOpenFile      :: String -> IOMode -> FHandle
 foreign import prim primStdin         :: FHandle
 foreign import prim primStdout        :: FHandle
@@ -63,35 +63,35 @@ foreign import prim primOpenFileOrStd :: String -> IOMode -> Maybe Int -> Handle
 
 
 hClose       :: Handle -> IO ()
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 hClose (OldHandle h)     =  ioFromPrim (\_ -> primHClose h)
 #else
 hClose h     =  ioFromPrim (\_ -> primHClose h)
 #endif
 
 hFlush       :: Handle -> IO ()
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 hFlush (OldHandle h)     =  ioFromPrim (\_ -> primHFlush h)
 #else
 hFlush h     =  ioFromPrim (\_ -> primHFlush h)
 #endif
 
 hGetChar     :: Handle -> IO Char
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 hGetChar (OldHandle h)   =  ioFromPrim (\_ -> primHGetChar h)
 #else
 hGetChar h   =  ioFromPrim (\_ -> primHGetChar h)
 #endif
 
 hPutChar     :: Handle -> Char -> IO ()
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 hPutChar (OldHandle h) c =  ioFromPrim (\_ -> primHPutChar h c)
 #else
 hPutChar h c =  ioFromPrim (\_ -> primHPutChar h c)
 #endif
 
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 openFile     :: FilePath -> IOMode -> IO Handle
 openFile f m =  ioFromPrim (\_ -> OldHandle (primOpenFile (forceString f) m))
@@ -176,7 +176,7 @@ hGetLine h = do { c <- hGetChar h
    hGetLine2 c    = do { cs <- hGetLine h
                        ; return (c:cs)
                        }
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
    getRest        = hGetLine h
 #else
    getRest        = do c <- catch (hGetChar h) 
@@ -219,7 +219,7 @@ appendFile       = writeFile2 AppendMode
 writeFile2      :: IOMode -> FilePath -> String -> IO ()
 writeFile2 mode name s 
     = do h <- openFile name mode
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
          hPutStr h s
 #else
          catchException (hPutStr h s) (\e -> hClose h >> throw e)
@@ -234,7 +234,7 @@ writeFile2 mode name s
 -- additional I/O primitives and their wrapping in the I/O monad
 ----------------------------------------------------------------
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 #else
 foreign import prim primHPutByteArray   :: Handle -> ByteArray -> ()
@@ -252,7 +252,7 @@ hGetContents     :: Handle -> IO String
 hPutStr          :: Handle -> String -> IO ()
 
 
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 hGetContents h = do b <- hIsEOF h
                     if b

EHC/ehclib/uhcbase/UHC/Run.chs

@@ -22,7 +22,7 @@ import System.IO (hPutStrLn)
 %%]
 
 %%[99
-#ifdef __UHC_TARGET_C__
+#if defined (__UHC_TARGET_C__) || defined (__UHC_TARGET_LLVM__)
 
 -- Wrapper around 'main', invoked as 'ehcRunMain main'
 ehcRunMain :: IO a -> IO a

EHC/src/ehc/EHC/CompilePhase/CompileLLVM.chs

@@ -45,6 +45,7 @@ cpCompileWithLLVM modNm
                             = map (\lib -> "-l " ++ lib)
                               $  map (mkl Cfg.INST_LIB) Cfg.libnamesGccPerVariant
                               ++ map (\l -> Cfg.mkInstallFilePrefix opts Cfg.INST_LIB_SHARED variant "" ++ Cfg.mkCLibFilename "" l) (Cfg.libnamesGcc opts)
+                              ++ map ("-l" ++) Cfg.libnamesGccEhcExtraExternalLibs
                             where mkl how l = Cfg.mkCLibFilename (Cfg.mkInstallFilePrefix opts how variant "") l
               inputOpts     = [ fpathToStr fpLL ]
               outputOpts    = ["-o " ++ fpathToStr fpExec]

EHC/src/rts/C/prim.cc

@@ -42,6 +42,7 @@ PRIM Word primOdd(Word x)
 
 PRIM Word primError(Word s)
 {
+    printf("DEBUG err: %u \n", s);
 	Word c;
 	char x;
 
@@ -117,6 +118,7 @@ PRIM Word primStdin()
 
 PRIM Word primStdout()
 {
+    printf("DEBUG: stdout: %u \n", stdout);
   	return (Word)stdout;
 }
 
@@ -191,6 +193,7 @@ PRIM Word primHGetChar(Word h)
 
 PRIM Word primHPutChar(Word h, Word c)
 {
+    printf("DEBUG: h:%u c:%u \n", h, c);
 	putc(c, (FILE*)h );
 	return RTS_Unit;
 }

EHC/src/rts/mm/llvm/tracesupplyglobals.cc

@@ -38,7 +38,7 @@ void mm_traceSupplyGlobals_llvm_Reset( MM_TraceSupply* traceSupply, Word gcStack
 void mm_traceSupplyGlobals_llvm_Run( MM_TraceSupply* traceSupply )
 {
 
-    //printf("mm_traceSupplyGlobals_llvm_Run\n");
+    printf("mm_traceSupplyGlobals_llvm_Run\n");
 
     Word nrObjs = _llvm_globals_descriptor_count;
     //printf("nr objs: %i \n", nrObjs);

EHC/src/rts/mm/semispace/ss.cc

@@ -99,7 +99,7 @@ void mm_plan_SS_Init( MM_Plan* plan ) {
 		, &plss->residentAllocator
 		, &plss->gbmTrace
 		, &plss->gbmModule
-%%[[94
+%%[[90
 		, &mm_weakPtr					// init later
 		, &plss->weakPtrFinalizeQue		// init later
 %%]]
@@ -303,8 +303,9 @@ Bool mm_plan_SS_DoGC( MM_Plan* plan, Bool isPreemptiveGC /*isSpaceFull*/, Word g
 		plss->collector.collect( &plss->collector, gcInfo ) ;
         Word afterUsedSz = plss->ssAllocator.getUsedSize( &plss->ssAllocator ) ;
 
-        if(beforeUsedSz != afterUsedSz)
+        //if(beforeUsedSz != afterUsedSz) {
             //fprintf(stderr, "#### TOTAL MEM: %i | USED MEM BEFORE GC: %i AFTER GC: %i \n", prevTotalSz, beforeUsedSz, afterUsedSz);
+        // }
 
 		// total as used now
 		if ( ! isPreemptiveGC ) {