diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -80,13 +80,13 @@ * Rewrite Cortex-M3 base library with Ajhc. * Analyze jhc internal (Japanese doc). http://metasepi.org/posts/2013-01-31-jhc_internal_overview.html -* Find critical region of Ajhc for reentrant and thread safe. * Port Haskell libraries on haskell-platform to Ajhc. * Understand jhc's region inference. -* Find the method to implement GC that can be interrupted. * 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. * Start rewritng NetBSD kernel with Ajhc. @@ -104,3 +104,5 @@ * Pass all regress test, and enable regress fail setting on travis-ci. https://travis-ci.org/ajhc/ajhc * No more depend on DrIFT. Use http://hackage.haskell.org/package/derive. +* Find critical region of Ajhc for reentrant and thread safe. +* Find the method to implement GC that can be interrupted. diff --git a/ajhc.cabal b/ajhc.cabal --- a/ajhc.cabal +++ b/ajhc.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.10 name: ajhc build-type: Custom -version: 0.8.0.6 +version: 0.8.0.7 license: GPL-2 license-file: COPYING category: Compiler @@ -22,6 +22,7 @@ . <> homepage: http://ajhc.metasepi.org/ +bug-reports: http://github.com/ajhc/ajhc/issues data-files: README.md diff --git a/lib/haskell-extras/Control/Concurrent.hs b/lib/haskell-extras/Control/Concurrent.hs --- a/lib/haskell-extras/Control/Concurrent.hs +++ b/lib/haskell-extras/Control/Concurrent.hs @@ -1,5 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} -module Control.Concurrent (forkOS, ThreadId) where +module Control.Concurrent (forkIO, forkOS, ThreadId) where import Foreign.Ptr import Foreign.StablePtr import Foreign.Storable @@ -33,3 +33,7 @@ i <- peek ip when (i /= 0) $ fail "Cannot create OS thread." return $ ThreadId pth + +-- xxx Should impl user thread. +forkIO :: IO () -> IO ThreadId +forkIO = forkOS diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -143,6 +143,7 @@ ------ --------------------------------------------------------------------------- \_JHC\_ARM\_STAY\_IN\_THUMB\_MODE set bit0 to any function pointers, for Cortex-M*. ([more detail](http://communities.mentor.com/community/cs/archives/arm-gnu/msg01904.html)) \_JHC\_JGC\_NAIVEGC run gc when have no more blocks. +\_JHC\_JGC\_SAVING\_MALLOC\_HEAP get smaller malloc heap. \_JHC\_JGC\_LIMITED\_NUM\_GC\_STACK number of limited gc_stack entries. \_JHC\_JGC\_GC\_STACK\_SHIFT bit shift to specify gc_stack size. Use it internally like this: (1 << (\_JHC\_JGC\_GC\_STACK\_SHIFT)). \_JHC\_JGC\_STACKGROW number of stack entry growed when run short of it. diff --git a/src/RawFiles.hs b/src/RawFiles.hs --- a/src/RawFiles.hs +++ b/src/RawFiles.hs @@ -276,20 +276,29 @@ \#include \"sys/queue.h\"\n\ \#include \"jhc_rts_header.h\"\n\ \#include \"rts/stableptr.h\"\n\ + \#include \"rts/conc.h\"\n\ \\n\ \struct StablePtr_list root_StablePtrs = LIST_HEAD_INITIALIZER();\n\ \\n\ \wptr_t c_newStablePtr(sptr_t c) {\n\ \ struct StablePtr* sp = malloc(sizeof(struct StablePtr));\n\ \ sp->contents = c;\n\ + \\n\ + \ jhc_rts_lock();\n\ \ LIST_INSERT_HEAD(&root_StablePtrs, sp, link);\n\ + \ jhc_rts_unlock();\n\ + \\n\ \ assert(GET_PTYPE(sp) == 0);\n\ \ return (wptr_t)TO_SPTR(P_VALUE,(wptr_t)sp);\n\ \}\n\ \\n\ \void c_freeStablePtr(wptr_t wp) {\n\ \ struct StablePtr *sp = FROM_SPTR((HsPtr)wp);\n\ + \\n\ + \ jhc_rts_lock();\n\ \ LIST_REMOVE(sp, link);\n\ + \ jhc_rts_unlock();\n\ + \\n\ \ free(sp);\n\ \}\n\ \\n\ @@ -1078,6 +1087,108 @@ {-# NOINLINE changelog #-} changelog :: ByteString changelog = unsafePerformIO $ unsafePackAddress "\ + \commit a50158d44738ec87b84d669c7b107f420a96aeea\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sat Jul 6 12:42:58 2013 +0900\n\ + \\n\ + \ Explain _JHC_JGC_SAVING_MALLOC_HEAP option on manual.html.\n\ + \\n\ + \commit fe6ad67ed02fd86aa4f49b532cdfebb82f6b1d21\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sat Jul 6 12:04:49 2013 +0900\n\ + \\n\ + \ Update release note.\n\ + \\n\ + \commit 847044c26c171a29ae1e6abe72947fd0bd91b6c2\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sat Jul 6 11:39:08 2013 +0900\n\ + \\n\ + \ Add release note 0.8.0.7.\n\ + \\n\ + \commit dbf77e15e6b8d8f6c9cb0d7818132c1976b94fed\n\ + \Author: Kiwamu Okabe \n\ + \Date: Fri Jul 5 11:30:57 2013 +0900\n\ + \\n\ + \ Update TODO.\n\ + \\n\ + \commit 8b5e6e05ef5612a723ec3c87d5b1c8a245d73633\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Jul 1 20:58:55 2013 +0900\n\ + \\n\ + \ First test for conc.\n\ + \\n\ + \commit 29fa0fd1c9be781053b14fd96b46b39f0efbd516\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Jul 1 20:09:08 2013 +0900\n\ + \\n\ + \ Ajhc does not have power to run ghc's conc test.\n\ + \\n\ + \commit a1427948df3b33c010585ca153dd99d7ad6b04e4\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Jul 1 16:47:58 2013 +0900\n\ + \\n\ + \ Copy tests from ghc-testsuite/tests/concurrent/should_run.\n\ + \\n\ + \commit f351a10d1ae512cbe8d7f868f96c5c8776429fd4\n\ + \Author: Kiwamu Okabe \n\ + \Date: Mon Jul 1 16:01:54 2013 +0900\n\ + \\n\ + \ Link forkIO to forkOS.\n\ + \\n\ + \commit 7bd4c22c05dcf82654d67fba42cf907da63eeef9\n\ + \Author: Kiwamu Okabe \n\ + \Date: Sat Jun 29 11:10:13 2013 +0900\n\ + \\n\ + \ Include conc_custom.h from RTS.\n\ + \\n\ + \commit 1705a52be8b717e5719fe22bdb2df0642944311a\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jun 26 19:52:16 2013 +0900\n\ + \\n\ + \ Change option name.\n\ + \\n\ + \commit cb35146be3db33d4ff9a48d274fe75120b4df159\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jun 26 05:24:23 2013 +0900\n\ + \\n\ + \ Remove copyright line from ajhc.cabal.\n\ + \\n\ + \commit 08f2288f6517948f7589c733a40312e447a1d9e4\n\ + \Author: Kiwamu Okabe \n\ + \Date: Wed Jun 26 03:10:27 2013 +0900\n\ + \\n\ + \ Add _JHC_JGC_ECO_MALLOC_HEAP option for getting smaller malloc heap.\n\ + \\n\ + \commit ea54bc873f5e789e87cb46aec26a8250b38b2d58\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Jun 20 16:19:03 2013 +0900\n\ + \\n\ + \ Expand chunk area on StringTable_cbits.c.\n\ + \\n\ + \commit dc73403b83e67cd2f586537a85eef2195e505868\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Jun 20 15:01:20 2013 +0900\n\ + \\n\ + \ Guard StablePtr critical section.\n\ + \\n\ + \commit e85a82e8df2453082d3093f8b9ebed07aed49d31\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Jun 20 05:08:58 2013 +0900\n\ + \\n\ + \ Add copyright and bug-reports to cabal file.\n\ + \\n\ + \commit dc4d9c8155ed9dd2e9a3028330736c5dec2033c3\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Jun 20 03:23:43 2013 +0900\n\ + \\n\ + \ Update TODO.\n\ + \\n\ + \commit 5cb67f51dc08a61a26e1df0fb2ce1308389e7af2\n\ + \Author: Kiwamu Okabe \n\ + \Date: Thu Jun 20 03:20:21 2013 +0900\n\ + \\n\ + \ Bump up version 0.8.0.7.\n\ + \\n\ \commit 2b5cacf5b5d9de9ee1c6b2dd843aa5a926a6db03\n\ \Author: Kiwamu Okabe \n\ \Date: Thu Jun 20 03:02:43 2013 +0900\n\ @@ -2444,7 +2555,7 @@ {-# NOINLINE shortchange_txt #-} shortchange_txt :: ByteString shortchange_txt = unsafePerformIO $ unsafePackAddress "\ - \2b5cacf5b5d9de9ee1c6b2dd843aa5a926a6db03\ + \a50158d44738ec87b84d669c7b107f420a96aeea\ \"# -- | Generated from rts\/rts\/slub.c @@ -2917,6 +3028,41 @@ \ stack->stack[stack->ptr++] = s;\n\ \}\n\ \\n\ + \static void\n\ + \gc_mark_deeper(struct stack *stack, unsigned *number_redirects)\n\ + \{\n\ + \ while(stack->ptr) {\n\ + \ entry_t *e = stack->stack[--stack->ptr];\n\ + \ struct s_block *pg = S_BLOCK(e);\n\ + \ if(!(pg->flags & SLAB_MONOLITH))\n\ + \ VALGRIND_MAKE_MEM_DEFINED(e,pg->u.pi.size * sizeof(uintptr_t));\n\ + \ debugf(\"Processing Grey: %p\\n\",e);\n\ + \ unsigned num_ptrs = pg->flags & SLAB_MONOLITH ? pg->u.m.num_ptrs : pg->u.pi.num_ptrs;\n\ + \ stack_check(stack, num_ptrs);\n\ + \ for(unsigned i = 0; i < num_ptrs; i++) {\n\ + \ if(1 && (P_LAZY == GET_PTYPE(e->ptrs[i]))) {\n\ + \ VALGRIND_MAKE_MEM_DEFINED(FROM_SPTR(e->ptrs[i]), sizeof(uintptr_t));\n\ + \ if(!IS_LAZY(GETHEAD(FROM_SPTR(e->ptrs[i])))) {\n\ + \ *number_redirects++;\n\ + \ debugf(\" *\");\n\ + \ e->ptrs[i] = (sptr_t)GETHEAD(FROM_SPTR(e->ptrs[i]));\n\ + \ }\n\ + \ }\n\ + \ if(IS_PTR(e->ptrs[i])) {\n\ + \ entry_t * ptr = TO_GCPTR(e->ptrs[i]);\n\ + \ debugf(\"Following: %p %p\\n\",e->ptrs[i], ptr);\n\ + \ gc_add_grey(stack, ptr);\n\ + \ }\n\ + \ }\n\ + \ }\n\ + \}\n\ + \\n\ + \#if defined(_JHC_JGC_SAVING_MALLOC_HEAP)\n\ + \#define DO_GC_MARK_DEEPER(S,N) gc_mark_deeper((S),(N))\n\ + \#else\n\ + \#define DO_GC_MARK_DEEPER(S,N) do { } while (/* CONSTCOND */ 0)\n\ + \#endif\n\ + \\n\ \void A_STD\n\ \gc_perform_gc(gc_t gc, arena_t arena)\n\ \{\n\ @@ -2935,17 +3081,26 @@ \ for(unsigned i = 0; i < root_stack.ptr; i++) {\n\ \ gc_add_grey(&stack, root_stack.stack[i]);\n\ \ debugf(\" %p\", root_stack.stack[i]);\n\ + \ DO_GC_MARK_DEEPER(&stack, &number_redirects);\n\ \ }\n\ \ debugf(\" # \");\n\ \ struct StablePtr *sp;\n\ + \\n\ + \ jhc_rts_lock();\n\ \ LIST_FOREACH(sp, &root_StablePtrs, link) {\n\ \ gc_add_grey(&stack, (entry_t *)sp);\n\ - \ debugf(\" %p\", root_stack.stack[i]);\n\ + \ debugf(\" %p\", sp);\n\ + \ DO_GC_MARK_DEEPER(&stack, &number_redirects);\n\ \ }\n\ + \ jhc_rts_unlock();\n\ \\n\ \ debugf(\"\\n\");\n\ \ debugf(\"Trace:\");\n\ + \#if defined(_JHC_JGC_SAVING_MALLOC_HEAP)\n\ + \ stack_check(&stack, 1); // Just alloc\n\ + \#else\n\ \ stack_check(&stack, gc - arena->gc_stack_base);\n\ + \#endif\n\ \ number_stack = gc - arena->gc_stack_base;\n\ \ for(unsigned i = 0; i < number_stack; i++) {\n\ \ debugf(\" |\");\n\ @@ -2971,33 +3126,11 @@ \ entry_t *e = TO_GCPTR(ptr);\n\ \ debugf(\" %p\",(void *)e);\n\ \ gc_add_grey(&stack, e);\n\ + \ DO_GC_MARK_DEEPER(&stack, &number_redirects);\n\ \ }\n\ \ debugf(\"\\n\");\n\ \\n\ - \ while(stack.ptr) {\n\ - \ entry_t *e = stack.stack[--stack.ptr];\n\ - \ struct s_block *pg = S_BLOCK(e);\n\ - \ if(!(pg->flags & SLAB_MONOLITH))\n\ - \ VALGRIND_MAKE_MEM_DEFINED(e,pg->u.pi.size * sizeof(uintptr_t));\n\ - \ debugf(\"Processing Grey: %p\\n\",e);\n\ - \ unsigned num_ptrs = pg->flags & SLAB_MONOLITH ? pg->u.m.num_ptrs : pg->u.pi.num_ptrs;\n\ - \ stack_check(&stack, num_ptrs);\n\ - \ for(unsigned i = 0; i < num_ptrs; i++) {\n\ - \ if(1 && (P_LAZY == GET_PTYPE(e->ptrs[i]))) {\n\ - \ VALGRIND_MAKE_MEM_DEFINED(FROM_SPTR(e->ptrs[i]), sizeof(uintptr_t));\n\ - \ if(!IS_LAZY(GETHEAD(FROM_SPTR(e->ptrs[i])))) {\n\ - \ number_redirects++;\n\ - \ debugf(\" *\");\n\ - \ e->ptrs[i] = (sptr_t)GETHEAD(FROM_SPTR(e->ptrs[i]));\n\ - \ }\n\ - \ }\n\ - \ if(IS_PTR(e->ptrs[i])) {\n\ - \ entry_t * ptr = TO_GCPTR(e->ptrs[i]);\n\ - \ debugf(\"Following: %p %p\\n\",e->ptrs[i], ptr);\n\ - \ gc_add_grey( &stack, ptr);\n\ - \ }\n\ - \ }\n\ - \ }\n\ + \ gc_mark_deeper(&stack, &number_redirects); // Final marking\n\ \ free(stack.stack);\n\ \ s_cleanup_blocks(arena);\n\ \ if (JHC_STATUS) {\n\ @@ -4984,10 +5117,11 @@ \#define jhc_mutex_unlock(M)\x0009\&pthread_mutex_unlock((M))\n\ \\n\ \#elif _JHC_CONC == _JHC_CONC_CUSTOM\n\ + \#include \"conc_custom.h\"\n\ \/* You should impl \"jhc_threadid_t\" and \"jhc_mutex_t\". */\n\ - \void jhc_mutex_init(jhc_mutex_t *mutex)\n\ - \void jhc_mutex_lock(jhc_mutex_t *mutex)\n\ - \void jhc_mutex_unlock(jhc_mutex_t *mutex)\n\ + \void jhc_mutex_init(jhc_mutex_t *mutex);\n\ + \void jhc_mutex_lock(jhc_mutex_t *mutex);\n\ + \void jhc_mutex_unlock(jhc_mutex_t *mutex);\n\ \\n\ \#else\n\ \#error \"You should choose _JHC_CONC.\"\n\ diff --git a/src/StringTable/StringTable_cbits.c b/src/StringTable/StringTable_cbits.c --- a/src/StringTable/StringTable_cbits.c +++ b/src/StringTable/StringTable_cbits.c @@ -33,7 +33,7 @@ // string allocation stuff -#define NUM_CHUNKS 256 +#define NUM_CHUNKS 384 #define CHUNK_SIZE 16384 #define ATOM_LEN(c) (((atom_t)(c) >> ATOM_LEN_SHIFT) & ATOM_LEN_MASK) 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.6" +version = "0.8.0.7" package = "ajhc" libdir = "/usr/local/lib" datadir = "/usr/local/share"