Good morning again,
Thank you for answering.
I am using ghc 5.04.1 I compiled myself on a linux box (Mandrake 8.2) .
I'm sending you the source code. Compiled it with the following commands :
ghc -ffi -c GetFNamesBckp.hs -o GetFNamesBckp.o
gcc -I/opt/installed/ghc-5.04.1/lib/ghc-5.04.1/include -c cGetFNamesBckp.c -o
cGetFNamesBckp.o
ghc -no-hs-main GetFNamesBckp_stub.o GetFNamesBckp.o cGetFNamesBckp.o
If you comment out the "foreign export" command on line 11 in
GetFNamesBckp.hs and do :
ghc --make Main.hs
Then the executable works ! That's why I thought it had to do with FFI and
memory allocation.
Thank you
Francis Girard
Le Conquet
France
Le 24 Octobre 2002 09:28, Simon Peyton-Jones a �crit :
> It's certainly a bug of some kind. Please say what version of GHC you
> are using. If it's the latest one (5.04.1), please send us the source
> code.
>
> Thanks
>
> Simon
>
> | -----Original Message-----
> | From: Francis Girard [mailto:francis.girard@;free.fr]
> | Sent: 24 October 2002 04:02
> | To: [EMAIL PROTECTED]
> | Subject: EVACUATED object entered! (when doing FFI)
> |
> | Good morning,
> |
> | I wrote a very small program, and it executed ok.
> | I wanted to export a function in "C", and therefore wrote a "C"
>
> wrapper
>
> | function over it to invoke peekCString and peekArray on the input;
>
> newCString
>
> | and newArray on the output.
> |
> | I then did a small "C" driver program. Everything compiled and linked
> | correctly.
> |
> | But at execution the program prints :
> |
> | EVACUATED object entered!
> |
> | as soon as "startupHaskell" is invoked (i.e. even before I call my
>
> foreign
>
> | exported function !)
> |
> | What is the meaning of this message ?
> |
> | Thank you
> |
> | Francis Girard
> | Le Conquet
> | France
> |
> |
> | _______________________________________________
> | Glasgow-haskell-users mailing list
> | [EMAIL PROTECTED]
> | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
-- GetFNamesBckp.hs
module GetFNamesBckp where
import Directory
import List
import Foreign
import Foreign.C
foreign export ccall getFNamesToZipC :: Int -> (Ptr CString) -> IO (Ptr CString)
----------------------------------------------------------------------------
-- Function getFNamesToZip
----------------------------------------------------------------------------
getFNamesToZipC :: Int -> (Ptr CString) -> IO (Ptr CString)
getFNamesToZipC nLen vFs
= do cfs <- peekArray nLen vFs
hfs <- peekCStringArr cfs
hzs <- getFNamesToZip hfs
czs <- createCStringArr hzs
vZs <- newArray czs
return vZs
where
peekCStringArr :: [CString] -> IO [String]
peekCStringArr [] = return []
peekCStringArr (cf:cfs) = do hf <- peekCString cf
hfs <- peekCStringArr cfs
return (hf : hfs)
createCStringArr :: [String] -> IO [CString]
createCStringArr [] = do sentinel <- newCString "//"
return [sentinel]
createCStringArr (hf:hfs) = do cf <- newCString hf
cfs <- createCStringArr hfs
return (cf : cfs)
getFNamesToZip :: [FilePath] -> IO [FilePath]
getFNamesToZip (f:fs)
= do isAFile <- doesFileExist f
isADir <- doesDirectoryExist f
if (isAFile)
then do ll <- getFNamesToZip fs
if (isFileToZip f) then return ([f] ++ ll) else return ll
else if (isADir) && (isDirToZip f)
then do subdir <- getDirectoryContents f
let subfs = [joinDirSubDir f sf | sf <- subdir, sf /= ".", sf /= ".."]
l1 <- getFNamesToZip subfs
l2 <- getFNamesToZip fs
return (l1 ++ l2)
else getFNamesToZip fs
getFNamesToZip [] = return []
joinDirSubDir :: FilePath -> FilePath -> FilePath
joinDirSubDir d sd
| (last d) == '/' = d ++ sd
| otherwise = (d ++ "/") ++ sd
----------------------------------------------------------------------------
-- Function globFilePattern
----------------------------------------------------------------------------
globFilePattern :: String -> String -> Bool
globFilePattern [] ('*':csPattern) = globFilePattern [] csPattern
globFilePattern [] [] = True
globFilePattern (_:_) [] = False
globFilePattern [] (_:_) = False
globFilePattern (cToMatch:csToMatch) ('*':csPattern)
| globFilePattern csToMatch csPattern = True
| otherwise = globFilePattern csToMatch ('*':csPattern)
globFilePattern (cToMatch:csToMatch) (cPattern:csPattern)
| cToMatch == cPattern = globFilePattern csToMatch csPattern
| otherwise = False
----------------------------------------------------------------------------
-- Function globFilePatternV
----------------------------------------------------------------------------
globFilePatternV :: String -> [String] -> Bool
globFilePatternV csToMatch [] = False
globFilePatternV csToMatch (p:ps)
| globFilePattern csToMatch p = True
| otherwise = globFilePatternV csToMatch ps
----------------------------------------------------------------------------
-- Function isFileToZip and isDirToZip
----------------------------------------------------------------------------
isFileToZip :: FilePath -> Bool
isFileToZip f = isFileToZipAI f getAddRegVec getIgnRegVec
isFileToZipAI :: FilePath -> [FilePath] -> [FilePath] -> Bool
isFileToZipAI f vAdd vIgn = (globFilePatternV f vAdd) && not (globFilePatternV f vIgn)
isDirToZip :: FilePath -> Bool
isDirToZip f = isFileToZipAI f (getAddRegVec ++ (getBaseDirVR getAddRegVec)) (getIgnRegVec)
getBaseDir :: FilePath -> FilePath
getBaseDir "/" = []
getBaseDir f = (rev . getFromSlash . rev) f
where rev :: FilePath -> FilePath
rev [] = []
rev (c:cs) = (rev cs) ++ [c]
getFromSlash :: FilePath -> FilePath
getFromSlash [] = []
getFromSlash "/" = "/"
getFromSlash ('/':cs) = cs
getFromSlash (_:cs) = getFromSlash cs
getBaseDirR :: FilePath -> [FilePath]
getBaseDirR [] = []
getBaseDirR f = getBaseDirR(getBaseDir f) ++ [getBaseDir f]
getBaseDirV :: [FilePath] -> [FilePath]
getBaseDirV = elimDup . map getBaseDir
getBaseDirVR :: [FilePath] -> [FilePath]
getBaseDirVR = elimEmp . elimDup . foldr (++) [] . map getBaseDirR
where elimEmp :: [FilePath] -> [FilePath]
elimEmp [] = []
elimEmp ("":fs) = elimEmp fs
elimEmp fs = fs
elimDup :: Ord a => [a] -> [a]
elimDup = foldr (++) [] . map (take 1) . group . sort
----------------------------------------------------------------------------
-- Functions getAddRegVec and getIgnRegVec
----------------------------------------------------------------------------
getAddRegVec :: [String]
getAddRegVec
= ["/home/francis/francis_cal.*",
"/home/francis/francis_cal.vcs",
"/home/francis/Mail/*",
"/home/francis/.aspell.fr.*",
"/home/francis/.bash_history",
"/home/francis/.lyx/*",
"/home/francis/.bash_logout",
"/home/francis/.bash_profile",
"/home/francis/.bashrc",
"/home/francis/.jedit/*",
"/home/francis/.menu/*",
"/home/francis/.xemacs/*",
"/home/francis/PERSONNEL/*"]
getIgnRegVec :: [String]
getIgnRegVec
= ["*.o",
"*.so",
"*.a",
"*.hi",
"*.pyc",
"*/FT-BOULOT*",
"*~"]
-- Main.hs
module Main where
import GetFNamesBckp
main :: IO ()
main = do putStrLn "Computing which files to zip ..."
vFNames <- getFNamesToZip ["/"]
putStrLn "******************* RESULTS"
printVec vFNames
return ()
printVec :: [String] -> IO()
printVec [] = return ()
printVec (a:as) = do putStrLn a
printVec as
// cGetFNamesBckp.c
#include <stdio.h>
#include "GetFNamesBckp_stub.h"
extern void __stginit_GetFNamesBckp(void);
int main( int argc, char** argv)
{
char* vsBaseDir = NULL;
char** vsBaseDirs = NULL;
char** vsNamesToZip = NULL;
char** it = NULL;
fprintf( stderr, "coucou0\n" );
startupHaskell(argc, argv, __stginit_GetFNamesBckp);
/* I did ugly explicit mallocs here because I was affraid
to give memory on the C stack to Haskell. I thought the
problem was coming from dangling pointers somewhere */
vsBaseDirs = (char**) malloc(sizeof(char*));
vsBaseDir = ( char* ) malloc( strlen("/") + 1 );
strcpy( vsBaseDir, "/" );
vsBaseDirs[0] = vsBaseDir;
fprintf( stderr, "coucou1\n" );
vsNamesToZip = getFNamesToZipC(1, vsBaseDirs);
fprintf( stderr, "coucou2\n" );
for( it = vsNamesToZip; strcmp(*it, "//") != 0; it++ )
printf("%s\n", *it);
fprintf( stderr, "coucou3\n" );
shutdownHaskell();
fprintf( stderr, "coucou4\n" );
return 0;
}
