diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -7,14 +7,16 @@ ## How to install + $ sudo apt-get install haskell-platform libncurses5-dev gcc m4 $ cabal install ajhc ## How to build latest version - $ sudo apt-get install make locales autoconf libreadline-dev libwww-perl libconfig-yaml-perl \ - graphviz haskell-platform pandoc hscolour po4a libghc-temporary-dev libghc-haskeline-dev - libghc-utf8-string-dev libghc-hssyck-dev libghc-test-framework-th-dev libghc-test-framework-hunit-dev - libghc-test-framework-quickcheck2-dev libgc-dev gcc-multilib valgrind + $ sudo apt-get install make locales autoconf libreadline-dev \ + libconfig-yaml-perl graphviz haskell-platform cpphs pandoc hscolour po4a \ + libghc-temporary-dev libghc-haskeline-dev libghc-utf8-string-dev libghc-hssyck-dev \ + libghc-test-framework-th-dev libghc-test-framework-hunit-dev \ + libghc-test-framework-quickcheck2-dev libghc-uniplate-dev libgc-dev gcc-multilib valgrind $ git clone git://github.com/ajhc/ajhc.git $ cd ajhc $ git checkout arafura @@ -79,12 +81,11 @@ * No more depend on Perl (LWP and YAML). * Rewrite Cortex-M3 base library with Ajhc. * Analyze jhc internal (Japanese doc). - http://metasepi.org/posts/2013-01-31-jhc_internal_overview.html + https://github.com/ajhc/ajhc-hacking-guide * Port Haskell libraries on haskell-platform to Ajhc. * Understand jhc's region inference. * Play with Android NDK. http://developer.android.com/tools/sdk/ndk/index.html * Play with Google Native Client. https://developers.google.com/native-client/ -* Play with Nintendo DS. http://devkitpro.org/wiki/Getting_Started/devkitARM * Snatch ChibiOS/RT. http://www.chibios.org/dokuwiki/doku.php * Write Linux kernel driver with Haskell. * Get smaller RTS. Benchmark the RTS for running on custom FPGA CPU. diff --git a/ajhc.cabal b/ajhc.cabal --- a/ajhc.cabal +++ b/ajhc.cabal @@ -1,12 +1,12 @@ cabal-version: >= 1.10 name: ajhc build-type: Custom -version: 0.8.0.7 +version: 0.8.0.8 license: GPL-2 license-file: COPYING category: Compiler author: John Meacham -maintainer: Kiwamu Okabe +maintainer: Metasepi team synopsis: Haskell compiler that produce binary through C language description: Ajhc is a fork of jhc. The jhc is a haskell compiler which aims to produce the most efficient @@ -323,7 +323,8 @@ network, pretty, process, - directory + directory, + ajhc if !os(windows) build-depends: diff --git a/lib/haskell-extras/Data/Bits.hs b/lib/haskell-extras/Data/Bits.hs --- a/lib/haskell-extras/Data/Bits.hs +++ b/lib/haskell-extras/Data/Bits.hs @@ -5,6 +5,7 @@ import Jhc.Num import Jhc.Order import Jhc.Basics +import Jhc.Type.C m4_include(Data/Bits.m4) @@ -159,3 +160,15 @@ BITSINST(Word64) BITSINST(WordPtr) BITSINST(WordMax) + +BITSINST(CChar,a) +BITSINST(CInt,a) +BITSINST(CLLong,a) +BITSINST(CLong,a) +BITSINST(CSChar,a) +BITSINST(CSize,a) +BITSINST(CUChar,a) +BITSINST(CUInt,a) +BITSINST(CULLong,a) +BITSINST(CULong,a) +BITSINST(CWchar,a) diff --git a/lib/jhc/Jhc/Inst/Enum.hs b/lib/jhc/Jhc/Inst/Enum.hs --- a/lib/jhc/Jhc/Inst/Enum.hs +++ b/lib/jhc/Jhc/Inst/Enum.hs @@ -59,8 +59,12 @@ ENUMINST(CLong) BOUNDED(CLong) +ENUMINST(CLLong) +BOUNDED(CLLong) ENUMINST(CULong) UBOUNDED(CULong) +ENUMINST(CULLong) +UBOUNDED(CULLong) instance Enum () where succ _ = error "Prelude.Enum.().succ: bad argument" diff --git a/lib/jhc/Jhc/Inst/Num.hs b/lib/jhc/Jhc/Inst/Num.hs --- a/lib/jhc/Jhc/Inst/Num.hs +++ b/lib/jhc/Jhc/Inst/Num.hs @@ -48,6 +48,8 @@ SIGNED(CSize) SIGNED(CInt) SIGNED(CLong) +SIGNED(CLLong) +UNSIGNED(CULLong) UNSIGNED(CULong) UNSIGNED(CUInt) UNSIGNED(CWchar) diff --git a/lib/jhc/Jhc/Inst/Order.hs b/lib/jhc/Jhc/Inst/Order.hs --- a/lib/jhc/Jhc/Inst/Order.hs +++ b/lib/jhc/Jhc/Inst/Order.hs @@ -34,3 +34,5 @@ INST_EQORDER(CSize,,CSize,) INST_EQORDER(CLong,,CLong,) INST_EQORDER(CULong,,CULong,U) +INST_EQORDER(CLLong,,CLLong,) +INST_EQORDER(CULLong,,CULLong,U) diff --git a/lib/jhc/Jhc/Inst/Show.hs b/lib/jhc/Jhc/Inst/Show.hs --- a/lib/jhc/Jhc/Inst/Show.hs +++ b/lib/jhc/Jhc/Inst/Show.hs @@ -65,6 +65,8 @@ showsPrec p x = showsPrec p (fromIntegral x :: Integer) instance Show CLong where showsPrec p x = showsPrec p (fromIntegral x :: Integer) +instance Show CLLong where + showsPrec p x = showsPrec p (fromIntegral x :: Integer) instance Show CChar where showsPrec p x = showsPrec p (fromIntegral x :: Int) @@ -75,6 +77,8 @@ instance Show CUInt where showsPrec _ x = showWord (fromIntegral x :: Word) instance Show CULong where + showsPrec _ x = showWordMax (fromIntegral x :: WordMax) +instance Show CULLong where showsPrec _ x = showWordMax (fromIntegral x :: WordMax) instance Show CWchar where showsPrec _ x = showWord (fromIntegral x :: Word) diff --git a/src/C/FromGrin2.hs b/src/C/FromGrin2.hs --- a/src/C/FromGrin2.hs +++ b/src/C/FromGrin2.hs @@ -594,7 +594,8 @@ vs' <- mapM convertVal vs rt <- convertTypes ty let addgc = if primSafety == JhcContext && fopts FO.Jgc then mgc else id - fcall = cast rt (functionCall (name $ unpackPS funcName) $ addgc [ cast (basicType' t) v | v <- vs' | t <- primArgTypes ]) + fcall'= functionCall (name $ unpackPS funcName) $ addgc [ cast (basicType' t) v | v <- vs' | t <- primArgTypes ] + fcall = if rt == voidType then fcall' else cast rt fcall' return (mempty, fcall) convertExp (Prim p vs ty) = do tell mempty { wRequires = primReqs p } diff --git a/src/Grin/Grin.hs b/src/Grin/Grin.hs --- a/src/Grin/Grin.hs +++ b/src/Grin/Grin.hs @@ -468,6 +468,7 @@ getType (BaseOp PeekVal [v]) = case getType v of TyPtr t -> [t] _ -> error "Exp.getType: PeekVal of non-pointer type" + getType (BaseOp PokeVal _) = [] getType (Return v) = getType v getType (Error _ t) = t getType (Case _ []) = error "empty case" diff --git a/src/Ho/ReadSource.hs b/src/Ho/ReadSource.hs --- a/src/Ho/ReadSource.hs +++ b/src/Ho/ReadSource.hs @@ -44,7 +44,7 @@ incFlags = [ "-I" ++ d | d <- optIncdirs opt ++ optIncs opt] defFlags = ("-D__JHC__=" ++ revision):("-D__JHC_VERSION__=" ++ version):[ "-D" ++ d | d <- optDefs opt] case () of - _ | fopts FO.Cpp -> readSystem "cpp" $ ["-CC","-traditional"] ++ incFlags ++ defFlags ++ [fn] + _ | fopts FO.Cpp -> readSystem "cpphs" $ incFlags ++ defFlags ++ [fn] | fopts FO.M4 -> do m4p <- m4Prelude readSystem "m4" $ ["-s", "-P"] ++ incFlags ++ defFlags ++ [m4p,fn] diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -150,6 +150,7 @@ \_JHC\_JGC\_LIMITED\_NUM\_MEGABLOCK number of limited megablock entries. \_JHC\_JGC\_BLOCK\_SHIFT bit shift to specify block size. Use it internally like this: (1 << (\_JHC\_JGC\_BLOCK\_SHIFT)). \_JHC\_JGC\_MEGABLOCK\_SHIFT bit shift to specify megablock size. Use it internally like this: (1 << (\_JHC\_JGC\_MEGABLOCK_SHIFT)). +\_JHC\_USE\_OWN\_STDIO force you should implement your own printf,fputs,fflush,getchar,getc,putchar,putc. -} @@ -196,6 +197,7 @@ optDeps :: Maybe FilePath, optHoDir :: Maybe FilePath, optHoCache :: Maybe FilePath, + optTargetsIni :: Maybe FilePath, optArgs :: [String], optStale :: [String], -- ^ treat these modules as stale optKeepGoing :: !Bool, -- ^ Keep going when encountering errors. @@ -256,6 +258,8 @@ optVerbose_u f r@Opt{optVerbose = x} = r{optVerbose = f x} optWorkDir_s v = optWorkDir_u (const v) optWorkDir_u f r@Opt{optWorkDir = x} = r{optWorkDir = f x} +optTargetsIni_s v = optTargetsIni_u (const v) +optTargetsIni_u f r@Opt{optTargetsIni = x} = r{optTargetsIni = f x} emptyOpt = Opt { optMode = CompileExe, @@ -279,6 +283,7 @@ optWorkDir = Nothing, optHoDir = Nothing, optHoCache = Nothing, + optTargetsIni = Nothing, optArgs = [], optIgnoreHo = False, optNoWriteHo = False, @@ -341,6 +346,7 @@ , Option [] ["list-libraries"] (NoArg (optMode_s ListLibraries)) "List of installed libraries" , Option [] ["tdir"] (ReqArg (optWorkDir_s . Just) "dir/") "specify the directory where all intermediate files/dumps will be placed." -- , Option [] ["print-hsc-options"] (NoArg (optMode_s PrintHscOptions)) "print options to pass to hsc2hs" + , Option [] ["targetsini"] (ReqArg (optTargetsIni_s . Just) "targets.ini") "specify the targets.ini file." ] stop "parse" = StopParse @@ -415,8 +421,14 @@ exitSuccess _ -> return () -- read targets.ini file + cabalEtc <- getDataFileNameMaybe "etc" Just home <- fmap (`mplus` Just "/") $ lookupEnv "HOME" - inis <- parseIniFiles (optVerbose o > 0) (BS.toString targets_ini) [confDir ++ "/targets.ini", confDir ++ "/targets-local.ini", home ++ "/etc/ajhc/targets.ini", home ++ "/.ajhc/targets.ini"] (optArch o) + let fromMaybeToList Nothing = [] + fromMaybeToList (Just s) = [s] + oTarget = fromMaybeToList $ optTargetsIni o + etcDir = fromMaybe confDir cabalEtc + iniFiles = [etcDir ++ "/targets.ini", etcDir ++ "/targets-local.ini", home ++ "/etc/ajhc/targets.ini", home ++ "/.ajhc/targets.ini"] ++ oTarget + inis <- parseIniFiles (optVerbose o > 0) (BS.toString targets_ini) iniFiles (optArch o) -- process dump flags o <- either putErrDie return $ postProcessFD o when (FlagDump.Ini `S.member` optDumpSet o) $ flip mapM_ (M.toList inis) $ \(a,b) -> putStrLn (a ++ "=" ++ b) diff --git a/src/RawFiles.hs b/src/RawFiles.hs --- a/src/RawFiles.hs +++ b/src/RawFiles.hs @@ -1087,6 +1087,205 @@ {-# NOINLINE changelog #-} changelog :: ByteString changelog = unsafePerformIO $ unsafePackAddress "\ + \commit a1265f031e6b75f9346ec23ca7caec0b5ced82bc\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Sep 2 16:12:19 2013 +0900\n\ + \\n\ + \ Retry cabal.\n\ + \\n\ + \commit 7433749a6076531d8ce230737c41bed1f3ad025b\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Sep 2 16:04:07 2013 +0900\n\ + \\n\ + \ Update manual.\n\ + \\n\ + \commit adb09c463e23dd6911f131d1d35f7b219c2f2cff\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Sep 2 15:38:51 2013 +0900\n\ + \\n\ + \ Add 0.8.0.8 release note.\n\ + \\n\ + \commit bdcf65fae813fb3224cb52f9d9c780b3c653a256\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Sep 2 14:36:37 2013 +0900\n\ + \\n\ + \ Retry on jahm.\n\ + \\n\ + \commit 934ab6503717937652236ed2ba72d3302ec65727\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Sep 2 12:43:50 2013 +0900\n\ + \\n\ + \ Use hackage.haskell.org. Come back.\n\ + \\n\ + \commit 3d3f641a0a69239ace5d1952a0843ea9e54e35e5\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sun Sep 1 16:34:12 2013 +0900\n\ + \\n\ + \ Use cabal's userAgent.\n\ + \\n\ + \commit efba18b08f88b9cce1af3f33f281f604eed4bc99\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sun Sep 1 16:12:23 2013 +0900\n\ + \\n\ + \ Try to use new-hackage.haskell.org with jahm.\n\ + \\n\ + \commit eee9c8f2fac28eb759d13672bbc7c3eb02b99fe9\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sun Sep 1 15:37:16 2013 +0900\n\ + \\n\ + \ Skip haddock on trasvis-ci for too slow.\n\ + \\n\ + \commit 7d57bf347e717b8384c08be1a60ff1e60908ce09\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sun Sep 1 15:17:17 2013 +0900\n\ + \\n\ + \ Retry test.\n\ + \\n\ + \commit ead8b4ed9e902009d880b0f808047389294a2c5a\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sun Sep 1 14:19:39 2013 +0900\n\ + \\n\ + \ Fix IORef compile BUG.\n\ + \ \n\ + \ Some time you can see compile error using IORef.\n\ + \ The poke action should have void type?\n\ + \\n\ + \commit 3c3aae70c09122c64ae3da4e471aa0cd412af78f\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sun Sep 1 09:25:50 2013 +0900\n\ + \\n\ + \ Data.Bits support CInt.\n\ + \\n\ + \commit 7b59bd1ec0e93206a73a61c8d8c3d15fe357a1ff\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Aug 29 00:06:42 2013 +0900\n\ + \\n\ + \ Add --targetsini option to specify the targets.ini file.\n\ + \\n\ + \commit 70cdc744800522b035d2ce207c62ffd9c15a6949\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Aug 28 21:48:22 2013 +0900\n\ + \\n\ + \ Read targets.ini file on .cabal dir.\n\ + \\n\ + \commit bb01384639bf71a07bbd2c02cbf3249f9c29b3d2\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Aug 28 19:01:02 2013 +0900\n\ + \\n\ + \ Split apt-get command to two times.\n\ + \\n\ + \commit 92d5371be3c3e7514b5945037d55e9972d23c6f9\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Aug 28 02:39:59 2013 +0900\n\ + \\n\ + \ Change link about internal doc.\n\ + \\n\ + \commit 06c7ca06d8d971bc7e3647f9799e441db58a94c0\n\ + \Author: Kiwamu Okabe \n\ + \Date: Tue Aug 27 20:06:19 2013 +0900\n\ + \\n\ + \ Support CULLong and CLLong type.\n\ + \\n\ + \commit d97c716b77c710503bf59828956e3a01e11b863d\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Aug 15 20:28:17 2013 +0900\n\ + \\n\ + \ Add jhc_fputs_stderr function to avoid not const compile error.\n\ + \\n\ + \commit 20bdab728cc6e860cc3b684d20bd75ed620bb89d\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Aug 15 11:43:40 2013 +0900\n\ + \\n\ + \ Change _JHC_USE_OWN_STDIO macro to define.\n\ + \\n\ + \commit a8461bb87b4de2b28c6cfe3fd1099e306b772dae\n\ + \Author: mzp \n\ + \Date: Wed Aug 14 23:55:27 2013 +0000\n\ + \\n\ + \ Don't insert (void) cast for function call. refs #34\n\ + \\n\ + \commit 45ffb8782687ad966ec5e0464554730e21b8530f\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Aug 15 02:04:06 2013 +0900\n\ + \\n\ + \ Update README to explain minimum debs needed.\n\ + \\n\ + \commit 18808645fc2f15178dd2de5de93ba377a7551d3f\n\ + \Author: Kiwamu Okabe \n\ + \Date: Tue Aug 13 20:47:43 2013 +0900\n\ + \\n\ + \ Change maintainer.\n\ + \\n\ + \commit 8b7874fcf3ec380849c0c04e42b9a16656a15d98\n\ + \Author: Kiwamu Okabe \n\ + \Date: Tue Aug 13 19:15:41 2013 +0900\n\ + \\n\ + \ Fix indent.\n\ + \\n\ + \commit 372848315adacc7cfbb7890c5577c8fc06c211b2\n\ + \Merge: 20e4f5e f3ff3f7\n\ + \Author: Kiwamu Okabe \n\ + \Date: Tue Aug 13 03:13:25 2013 -0700\n\ + \\n\ + \ Merge pull request #32 from mzp/fix_limited_megablock_count\n\ + \ \n\ + \ Fix GC: don't increment megablock count, when re-use the megablock in free list\n\ + \ I'm confused. It's a BUG of my code. Merged.\n\ + \\n\ + \commit f3ff3f776c208915932cddf84a1956fa69a3c300\n\ + \Author: mzp \n\ + \Date: Tue Aug 13 06:20:06 2013 +0000\n\ + \\n\ + \ Fix GC: don't increment megablock count, when re-use the megablock in free list\n\ + \\n\ + \commit 20e4f5e65d3d5dc8b93a48738c3cb72cf463e603\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sat Aug 10 19:34:19 2013 +0900\n\ + \\n\ + \ Use own functions for jhc_utf8_{getchar,getc,putchar,putc} with _JHC_USE_OWN_STDIO flag.\n\ + \\n\ + \commit c59f40382a2d3b82539dda89e575ab838d601592\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sat Aug 10 19:03:40 2013 +0900\n\ + \\n\ + \ Use jhc_printf_stderr instead of fprintf.\n\ + \\n\ + \commit 48eb7579669464579ae23b76f79e676c64284266\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jul 24 18:18:42 2013 +0900\n\ + \\n\ + \ Need libconfig-yaml-perl for regress test.\n\ + \\n\ + \commit 0be313fea254039803d444e503c1c44bcf9b7dbd\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jul 24 17:54:18 2013 +0900\n\ + \\n\ + \ No need any perl lib.\n\ + \\n\ + \commit f6c3f4b070acad8a5012682810f0f4d7b7b9ed44\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jul 10 10:47:57 2013 +0900\n\ + \\n\ + \ Update README for new Debian packages.\n\ + \\n\ + \commit 4a7aebe6b2693d52404efb1e27a4a65ab931bbdb\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jul 10 02:03:15 2013 +0900\n\ + \\n\ + \ Run apt-get install cpphs on travis-ci.\n\ + \\n\ + \commit c79980df7f776fb4c0494d05732b8e707f1c1194\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jul 10 01:48:43 2013 +0900\n\ + \\n\ + \ Use cpphs command instead of cpp.\n\ + \\n\ + \commit 41ef1a2468add8cdb47592fa6891d92ea2b87e68\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sat Jul 6 13:00:55 2013 +0900\n\ + \\n\ + \ Bump up version 0.8.0.8.\n\ + \\n\ \commit a50158d44738ec87b84d669c7b107f420a96aeea\n\ \Author: Kiwamu Okabe \n\ \Date: Sat Jul 6 12:42:58 2013 +0900\n\ @@ -2555,7 +2754,7 @@ {-# NOINLINE shortchange_txt #-} shortchange_txt :: ByteString shortchange_txt = unsafePerformIO $ unsafePackAddress "\ - \a50158d44738ec87b84d669c7b107f420a96aeea\ + \a1265f031e6b75f9346ec23ca7caec0b5ced82bc\ \"# -- | Generated from rts\/rts\/slub.c @@ -2582,6 +2781,7 @@ \\n\ \#include \"sys/bitarray.h\"\n\ \#include \"sys/queue.h\"\n\ + \#include \"rts/profile.h\"\n\ \\n\ \struct s_arena {\n\ \ struct s_megablock *current_megablock;\n\ @@ -2660,7 +2860,7 @@ \ int ret = posix_memalign(&mb->base,BLOCK_SIZE,MEGABLOCK_SIZE);\n\ \#endif\n\ \ if(ret != 0) {\n\ - \ fprintf(stderr,\"Unable to allocate memory for megablock\\n\");\n\ + \ jhc_printf_stderr(\"Unable to allocate memory for megablock\\n\");\n\ \ abort();\n\ \ }\n\ \ VALGRIND_MAKE_MEM_NOACCESS(mb->base,MEGABLOCK_SIZE);\n\ @@ -2803,7 +3003,7 @@ \ SLIST_INSERT_HEAD(&sc->full_blocks,pg,link);\n\ \ }\n\ \ assert(S_BLOCK(val) == pg);\n\ - \ //printf(\"s_alloc: val: %p s_block: %p size: %i color: %i found: %i num_free: %i\\n\", val, pg, pg->pi.size, pg->pi.color, found, pg->num_free);\n\ + \ //jhc_printf_stderr(\"s_alloc: val: %p s_block: %p size: %i color: %i found: %i num_free: %i\\n\", val, pg, pg->pi.size, pg->pi.color, found, pg->num_free);\n\ \ return val;\n\ \ }\n\ \}\n\ @@ -2815,7 +3015,7 @@ \ assert(val);\n\ \ struct s_block *pg = s_block(val);\n\ \ unsigned int offset = ((uintptr_t *)val - (uintptr_t *)pg) - pg->pi.color;\n\ - \// printf(\"s_free: val: %p s_block: %p size: %i color: %i num_free: %i offset: %i bit: %i\\n\", val, pg, pg->pi.size, pg->pi.color, pg->num_free, offset, offset/pg->pi.size);\n\ + \// jhc_printf_stderr(\"s_free: val: %p s_block: %p size: %i color: %i num_free: %i offset: %i bit: %i\\n\", val, pg, pg->pi.size, pg->pi.color, pg->num_free, offset, offset/pg->pi.size);\n\ \ assert(BIT_VALUE(pg->used,offset/(pg->pi.size)));\n\ \ BIT_UNSET(pg->used,offset/(pg->pi.size));\n\ \ pg->num_free++;\n\ @@ -2908,21 +3108,21 @@ \\n\ \void\n\ \print_cache(struct s_cache *sc) {\n\ - \ fprintf(stderr, \"num_entries: %i\\n\",(int)sc->num_entries);\n\ - \// printf(\" entries: %i words\\n\",(int)(sc->num_entries*sc->pi.size));\n\ - \ fprintf(stderr, \" header: %lu bytes\\n\", sizeof(struct s_block) + BITARRAY_SIZE_IN_BYTES(sc->num_entries));\n\ - \ fprintf(stderr, \" size: %i words\\n\",(int)sc->pi.size);\n\ - \// printf(\" color: %i words\\n\",(int)sc->pi.color);\n\ - \ fprintf(stderr, \" nptrs: %i words\\n\",(int)sc->pi.num_ptrs);\n\ - \// printf(\" end: %i bytes\\n\",(int)(sc->pi.color+ sc->num_entries*sc->pi.size)*sizeof(uintptr_t));\n\ - \ fprintf(stderr, \"%20s %9s %9s %s\\n\", \"block\", \"num_free\", \"next_free\", \"status\");\n\ + \ jhc_printf_stderr( \"num_entries: %i\\n\",(int)sc->num_entries);\n\ + \// jhc_printf_stderr(\" entries: %i words\\n\",(int)(sc->num_entries*sc->pi.size));\n\ + \ jhc_printf_stderr( \" header: %lu bytes\\n\", sizeof(struct s_block) + BITARRAY_SIZE_IN_BYTES(sc->num_entries));\n\ + \ jhc_printf_stderr( \" size: %i words\\n\",(int)sc->pi.size);\n\ + \// jhc_printf_stderr(\" color: %i words\\n\",(int)sc->pi.color);\n\ + \ jhc_printf_stderr( \" nptrs: %i words\\n\",(int)sc->pi.num_ptrs);\n\ + \// jhc_printf_stderr(\" end: %i bytes\\n\",(int)(sc->pi.color+ sc->num_entries*sc->pi.size)*sizeof(uintptr_t));\n\ + \ jhc_printf_stderr( \"%20s %9s %9s %s\\n\", \"block\", \"num_free\", \"next_free\", \"status\");\n\ \ struct s_block *pg;\n\ \ SLIST_FOREACH(pg,&sc->blocks,link) {\n\ - \ fprintf(stderr, \"%20p %9i %9i %c\\n\", pg, pg->num_free, pg->next_free, 'P');\n\ + \ jhc_printf_stderr( \"%20p %9i %9i %c\\n\", pg, pg->num_free, pg->next_free, 'P');\n\ \ }\n\ - \ fprintf(stderr, \" full_blocks:\\n\");\n\ + \ jhc_printf_stderr( \" full_blocks:\\n\");\n\ \ SLIST_FOREACH(pg,&sc->full_blocks,link) {\n\ - \ fprintf(stderr, \"%20p %9i %9i %c\\n\", pg, pg->num_free, pg->next_free, 'F');\n\ + \ jhc_printf_stderr( \"%20p %9i %9i %c\\n\", pg, pg->num_free, pg->next_free, 'F');\n\ \ }\n\ \}\n\ \\n\ @@ -3134,7 +3334,7 @@ \ free(stack.stack);\n\ \ s_cleanup_blocks(arena);\n\ \ if (JHC_STATUS) {\n\ - \ fprintf(stderr, \"%3u - %6u Used: %4u Thresh: %4u Ss: %5u Ps: %5u Rs: %5u Root: %3u\\n\",\n\ + \ jhc_printf_stderr(\"%3u - %6u Used: %4u Thresh: %4u Ss: %5u Ps: %5u Rs: %5u Root: %3u\\n\",\n\ \ arena->number_gcs,\n\ \ arena->number_allocs,\n\ \ (unsigned)arena->block_used,\n\ @@ -3202,9 +3402,9 @@ \ struct s_cache *sc;\n\ \\n\ \ if(_JHC_PROFILE || JHC_STATUS) {\n\ - \ fprintf(stderr, \"arena: %p\\n\", arena);\n\ - \ fprintf(stderr, \" block_used: %i\\n\", arena->block_used);\n\ - \ fprintf(stderr, \" block_threshold: %i\\n\", arena->block_threshold);\n\ + \ jhc_printf_stderr(\"arena: %p\\n\", arena);\n\ + \ jhc_printf_stderr(\" block_used: %i\\n\", arena->block_used);\n\ + \ jhc_printf_stderr(\" block_threshold: %i\\n\", arena->block_threshold);\n\ \ struct s_cache *sc;\n\ \ SLIST_FOREACH(sc,&arena->caches,next)\n\ \ print_cache(sc);\n\ @@ -3331,7 +3531,7 @@ \ int ret = posix_memalign(&base,BLOCK_SIZE,MEGABLOCK_SIZE);\n\ \#endif\n\ \ if(ret != 0) {\n\ - \ fprintf(stderr,\"Unable to allocate memory for aligned alloc: %u\\n\", size);\n\ + \ jhc_printf_stderr(\"Unable to allocate memory for aligned alloc: %u\\n\", size);\n\ \ abort();\n\ \ }\n\ \ return base;\n\ @@ -3346,17 +3546,17 @@ \ SLIST_REMOVE(&free_megablocks, mb, s_megablock, next);\n\ \ } else {\n\ \ mb = malloc(sizeof(*mb));\n\ - \ }\n\ \#ifdef _JHC_JGC_LIMITED_NUM_MEGABLOCK\n\ - \ static int count = 0;\n\ - \ if (count >= _JHC_JGC_LIMITED_NUM_MEGABLOCK) {\n\ - \ abort();\n\ - \ }\n\ - \ mb->base = aligned_megablock + (MEGABLOCK_SIZE) * count;\n\ - \ count++;\n\ + \ static int count = 0;\n\ + \ if (count >= _JHC_JGC_LIMITED_NUM_MEGABLOCK) {\n\ + \ abort();\n\ + \ }\n\ + \ mb->base = aligned_megablock + (MEGABLOCK_SIZE) * count;\n\ + \ count++;\n\ \#else\n\ - \ mb->base = jhc_aligned_alloc(MEGABLOCK_SIZE);\n\ + \ mb->base = jhc_aligned_alloc(MEGABLOCK_SIZE);\n\ \#endif\n\ + \ }\n\ \ jhc_rts_unlock();\n\ \\n\ \ VALGRIND_MAKE_MEM_NOACCESS(mb->base,MEGABLOCK_SIZE);\n\ @@ -3559,7 +3759,7 @@ \ SLIST_INSERT_HEAD(&sc->full_blocks,pg,link);\n\ \ }\n\ \ assert(S_BLOCK(val) == pg);\n\ - \ //printf(\"s_alloc: val: %p s_block: %p size: %i color: %i found: %i num_free: %i\\n\", val, pg, pg->pi.size, pg->pi.color, found, pg->num_free);\n\ + \ //jhc_printf_stderr(\"s_alloc: val: %p s_block: %p size: %i color: %i found: %i num_free: %i\\n\", val, pg, pg->pi.size, pg->pi.color, found, pg->num_free);\n\ \ return val;\n\ \ }\n\ \}\n\ @@ -3740,23 +3940,23 @@ \\n\ \void\n\ \print_cache(struct s_cache *sc) {\n\ - \ fprintf(stderr, \"num_entries: %i with %lu bytes of header\\n\",\n\ + \ jhc_printf_stderr(\"num_entries: %i with %lu bytes of header\\n\",\n\ \ (int)sc->num_entries, sizeof(struct s_block) +\n\ \ BITARRAY_SIZE_IN_BYTES(sc->num_entries));\n\ - \ fprintf(stderr, \" size: %i words %i ptrs\\n\",\n\ + \ jhc_printf_stderr(\" size: %i words %i ptrs\\n\",\n\ \ (int)sc->size,(int)sc->num_ptrs);\n\ \#if _JHC_PROFILE\n\ - \ fprintf(stderr, \" allocations: %lu\\n\", (unsigned long)sc->allocations);\n\ + \ jhc_printf_stderr(\" allocations: %lu\\n\", (unsigned long)sc->allocations);\n\ \#endif\n\ \ if(SLIST_EMPTY(&sc->blocks) && SLIST_EMPTY(&sc->full_blocks))\n\ \ return;\n\ - \ fprintf(stderr, \" blocks:\\n\");\n\ - \ fprintf(stderr, \"%20s %9s %9s %s\\n\", \"block\", \"num_free\", \"next_free\", \"status\");\n\ + \ jhc_printf_stderr(\" blocks:\\n\");\n\ + \ jhc_printf_stderr(\"%20s %9s %9s %s\\n\", \"block\", \"num_free\", \"next_free\", \"status\");\n\ \ struct s_block *pg;\n\ \ SLIST_FOREACH(pg,&sc->blocks,link)\n\ - \ fprintf(stderr, \"%20p %9i %9i %c\\n\", pg, pg->u.pi.num_free, pg->u.pi.next_free, 'P');\n\ + \ jhc_printf_stderr(\"%20p %9i %9i %c\\n\", pg, pg->u.pi.num_free, pg->u.pi.next_free, 'P');\n\ \ SLIST_FOREACH(pg,&sc->full_blocks,link)\n\ - \ fprintf(stderr, \"%20p %9i %9i %c\\n\", pg, pg->u.pi.num_free, pg->u.pi.next_free, 'F');\n\ + \ jhc_printf_stderr(\"%20p %9i %9i %c\\n\", pg, pg->u.pi.num_free, pg->u.pi.next_free, 'F');\n\ \}\n\ \\n\ \void hs_perform_gc(void) {\n\ @@ -3874,6 +4074,7 @@ \\n\ \#include \"jhc_rts_header.h\"\n\ \\n\ + \#if 0\n\ \void A_UNUSED\n\ \profile_print_header(FILE *file, char *value_unit)\n\ \{\n\ @@ -3885,6 +4086,7 @@ \ fprintf(file, \"SAMPLE_UNIT \\\"seconds\\\"\\n\");\n\ \ fprintf(file, \"VALUE_UNIT \\\"%s\\\"\\n\", value_unit ? value_unit : \"bytes\");\n\ \}\n\ + \#endif /* 0 */\n\ \\n\ \#if HAVE_TIMES\n\ \struct profile_stack {\n\ @@ -3913,9 +4115,9 @@ \void print_times(struct tms *tm) {\n\ \#if !defined(__WIN32__) && !defined(__ARM_EABI__)\n\ \ float cpt = (float)sysconf(_SC_CLK_TCK);\n\ - \ fprintf(stderr, \"User Time: %.2fs\\n\", (float)tm->tms_utime/cpt);\n\ - \ fprintf(stderr, \"System Time: %.2fs\\n\", (float)tm->tms_stime/cpt);\n\ - \ fprintf(stderr, \"Total Time: %.2fs\\n\", (float)(tm->tms_stime + tm->tms_utime)/cpt);\n\ + \ jhc_printf_stderr(\"User Time: %.2fs\\n\", (float)tm->tms_utime/cpt);\n\ + \ jhc_printf_stderr(\"System Time: %.2fs\\n\", (float)tm->tms_stime/cpt);\n\ + \ jhc_printf_stderr(\"Total Time: %.2fs\\n\", (float)(tm->tms_stime + tm->tms_utime)/cpt);\n\ \#endif\n\ \ return;\n\ \}\n\ @@ -3930,11 +4132,11 @@ \void A_COLD\n\ \jhc_print_profile(void) {\n\ \ if(!(_JHC_PROFILE || getenv(\"AJHC_RTS_PROFILE\"))) return;\n\ - \ fprintf(stderr, \"\\n-----------------\\n\");\n\ - \ fprintf(stderr, \"Profiling: %s\\n\", jhc_progname);\n\ - \ fprintf(stderr, \"Command: %s\\n\", jhc_command);\n\ - \ fprintf(stderr, \"Complie: %s\\n\", jhc_c_compile);\n\ - \ fprintf(stderr, \"Version: %s\\n\\n\", jhc_version);\n\ + \ jhc_printf_stderr(\"\\n-----------------\\n\");\n\ + \ jhc_printf_stderr(\"Profiling: %s\\n\", jhc_progname);\n\ + \ jhc_printf_stderr(\"Command: %s\\n\", jhc_command);\n\ + \ jhc_printf_stderr(\"Complie: %s\\n\", jhc_c_compile);\n\ + \ jhc_printf_stderr(\"Version: %s\\n\\n\", jhc_version);\n\ \#if HAVE_TIMES\n\ \ struct tms tm;\n\ \ times(&tm);\n\ @@ -3944,7 +4146,7 @@ \ print_times(&gc_gc_time.tm_total);\n\ \ print_times(&gc_alloc_time.tm_total);\n\ \#endif\n\ - \ fprintf(stderr, \"-----------------\\n\");\n\ + \ jhc_printf_stderr(\"-----------------\\n\");\n\ \}\n\ \\n\ \#if _JHC_PROFILE && _JHC_GC != _JHC_GC_JGC\n\ @@ -3965,12 +4167,12 @@ \print_alloc_size_stats(void) {\n\ \ char fmt[] = \"%10s %10s %10s %10s %10s\\n\";\n\ \ char fmt2[] = \"%10u %10u %10u %10u %10u\\n\";\n\ - \ fprintf(stderr,fmt,\"Size\",\"Normal\",\"Atomic\",\"Total\",\"Accum\");\n\ - \ fprintf(stderr,fmt,\"----\",\"------\",\"------\",\"-----\",\"-----\");\n\ + \ jhc_printf_stderr(fmt,\"Size\",\"Normal\",\"Atomic\",\"Total\",\"Accum\");\n\ + \ jhc_printf_stderr(fmt,\"----\",\"------\",\"------\",\"-----\",\"-----\");\n\ \ unsigned accum = 0;\n\ \ for(int i = 0; i < BUCKETS; i++) {\n\ \ accum += alloced[i] + alloced_atomic[i];\n\ - \ fprintf(stderr,fmt2,i,alloced[i],alloced_atomic[i],alloced_atomic[i] + alloced[i], accum);\n\ + \ jhc_printf_stderr(fmt2,i,alloced[i],alloced_atomic[i],alloced_atomic[i] + alloced[i], accum);\n\ \ }\n\ \}\n\ \#endif\n\ @@ -4103,7 +4305,7 @@ \ do { } while (0)\n\ \#endif\n\ \\n\ - \void A_UNUSED profile_print_header(FILE *file, char *value_unit);\n\ + \// void A_UNUSED profile_print_header(FILE *file, char *value_unit);\n\ \void A_COLD jhc_print_profile(void);\n\ \\n\ \#if _JHC_PROFILE\n\ @@ -4121,13 +4323,24 @@ \#define print_alloc_size_stats() do { } while(0)\n\ \#endif\n\ \\n\ + \#ifdef _JHC_USE_OWN_STDIO\n\ + \/* Implement us! */\n\ + \int jhc_printf_stderr(const char *fmt, ...);\n\ + \int jhc_fputs_stderr(const char *s);\n\ + \int jhc_fflush_stdout(void);\n\ + \#else\n\ + \#define jhc_printf_stderr(...) fprintf(stderr,__VA_ARGS__)\n\ + \#define jhc_fputs_stderr(S) fputs(S, stderr)\n\ + \#define jhc_fflush_stdout() fflush(stdout)\n\ + \#endif /* _JHC_USE_OWN_STDIO */\n\ + \\n\ \#if JHC_STATUS > 1\n\ - \#define debugf(...) fprintf(stderr,__VA_ARGS__)\n\ + \#define debugf(...) jhc_printf_stderr(__VA_ARGS__)\n\ \#else\n\ \#define debugf(...) do { } while (0)\n\ \#endif\n\ \\n\ - \#endif\n\ + \#endif /* RTS_PROFILE_H */\n\ \"# -- | Generated from rts\/rts\/cdefs.h @@ -4222,23 +4435,23 @@ \\n\ \void A_NORETURN A_UNUSED A_COLD\n\ \jhc_exit(int n) {\n\ - \ fflush(stdout);\n\ + \ jhc_fflush_stdout();\n\ \ jhc_print_profile();\n\ \ exit(n);\n\ \}\n\ \\n\ \void A_NORETURN A_UNUSED A_COLD\n\ \jhc_error(char *s) {\n\ - \ fflush(stdout);\n\ - \ fputs(s,stderr);\n\ - \ fputs(\"\\n\",stderr);\n\ + \ jhc_fflush_stdout();\n\ + \ jhc_fputs_stderr(s);\n\ + \ jhc_fputs_stderr(\"\\n\");\n\ \ jhc_exit(1);\n\ \}\n\ \\n\ \void A_NORETURN A_UNUSED A_COLD\n\ \jhc_case_fell_off(int n) {\n\ - \ fflush(stdout);\n\ - \ fprintf(stderr, \"\\n%s:%i: case fell off\\n\", __FILE__, n);\n\ + \ jhc_fflush_stdout();\n\ + \ jhc_printf_stderr(\"\\n%s:%i: case fell off\\n\", __FILE__, n);\n\ \ abort();\n\ \}\n\ \\n\ @@ -4270,7 +4483,7 @@ \hs_exit(void)\n\ \{\n\ \ if(!hs_init_count) {\n\ - \ fprintf(stderr, \"hs_exit() called before hs_init()\\n\");\n\ + \ jhc_printf_stderr(\"hs_exit() called before hs_init()\\n\");\n\ \ abort();\n\ \ }\n\ \ if(!--hs_init_count) {\n\ @@ -4377,7 +4590,7 @@ \void\n\ \jhc_alloc_fini(void) {\n\ \ if(_JHC_PROFILE) {\n\ - \ fprintf(stderr, \"Memory Allocated: %u bytes\\n\", (JHC_MEM_CHUNK_SIZE*(mem_chunks)) + mem_offset);\n\ + \ jhc_printf_stderr(\"Memory Allocated: %u bytes\\n\", (JHC_MEM_CHUNK_SIZE*(mem_chunks)) + mem_offset);\n\ \ print_alloc_size_stats();\n\ \ }\n\ \}\n\ @@ -4386,7 +4599,7 @@ \jhc_malloc_grow(void) {\n\ \ void *c = malloc(JHC_MEM_CHUNK_SIZE);\n\ \ if(!c) {\n\ - \ fputs(\"Out of memory!\\n\",stderr);\n\ + \ jhc_fputs_stderr(\"Out of memory!\\n\");\n\ \ abort();\n\ \ }\n\ \ mem_chunks++;\n\ @@ -4926,6 +5139,13 @@ \extern HsInt jhc_data_unique;\n\ \HsBool jhc_wait_for_input(FILE *f,HsInt timeout);\n\ \\n\ + \#ifdef _JHC_USE_OWN_STDIO\n\ + \/* Implement us! */\n\ + \int jhc_utf8_getchar(void);\n\ + \int jhc_utf8_getc(FILE *f);\n\ + \int jhc_utf8_putchar(int ch);\n\ + \int jhc_utf8_putc(int ch, FILE *f);\n\ + \#else\n\ \inline static int A_UNUSED\n\ \jhc_utf8_getchar(void)\n\ \{\n\ @@ -4949,6 +5169,7 @@ \{\n\ \ return putc(ch,f);\n\ \}\n\ + \#endif /* _JHC_USE_OWN_STDIO */\n\ \\n\ \#endif\n\ \"# diff --git a/src/Version/Config.hs b/src/Version/Config.hs --- a/src/Version/Config.hs +++ b/src/Version/Config.hs @@ -1,7 +1,7 @@ module Version.Config where shortVersion = "0.8" -version = "0.8.0.7" +version = "0.8.0.8" package = "ajhc" libdir = "/usr/local/lib" datadir = "/usr/local/share" diff --git a/src_jahm/Distribution/Client/HttpUtils.hs b/src_jahm/Distribution/Client/HttpUtils.hs --- a/src_jahm/Distribution/Client/HttpUtils.hs +++ b/src_jahm/Distribution/Client/HttpUtils.hs @@ -57,7 +57,7 @@ , rqMethod = GET , rqHeaders = [Header HdrUserAgent userAgent] , rqBody = ByteString.empty } - where userAgent = "cabal-install/0.1(jahm)" + where userAgent = "cabal-install/1.17.0" -- act like cabal -- |Carry out a GET request, using the local proxy settings getHTTP :: Verbosity -> URI -> IO (Result (Response ByteString)) diff --git a/src_jahm/Main.hs b/src_jahm/Main.hs --- a/src_jahm/Main.hs +++ b/src_jahm/Main.hs @@ -26,6 +26,7 @@ import Network.URI (parseURI) import Distribution.Client.HttpUtils (downloadURI) import Distribution.Verbosity (verbose) +import GenUtil (iocatch) main :: IO () main = getArgs >>= mainWorker @@ -33,5 +34,6 @@ mainWorker :: [String] -> IO () mainWorker ("downloadURI":u:f:[]) = do curDir <- getCurrentDirectory let Just url = parseURI u - downloadURI verbose url $ curDir f + retry $ downloadURI verbose url $ curDir f + where retry io = io `iocatch` const io mainWorker _ = print "help" diff --git a/utils/build_extlibs.prl b/utils/build_extlibs.prl --- a/utils/build_extlibs.prl +++ b/utils/build_extlibs.prl @@ -3,10 +3,6 @@ use strict; use warnings; -# xxx LWP getstore may return 500 error on Windows+msys+virtualbox. -# xxx I can't understand the below MAGIC... -# xxx http://lwp.interglacial.com/ch02_03.htm -use LWP::Simple qw(!head); use Cwd; use Getopt::Std; @@ -53,6 +49,7 @@ print "Processing $fn, found $name-$version\n"; my $url = "http://hackage.haskell.org/packages/archive/$name/$version/$name-$version.tar.gz"; +# my $url = "http://new-hackage.haskell.org/package/$name-$version/$name-$version.tar.gz"; print "Fetching $url\n"; unless(-e "$tmpdir/$name-$version.tar.gz") { mysystem "$opt_j downloadURI $url $tmpdir/$name-$version.tar.gz";