[Use cpphs, because gcc-4.8.1's cpp has error.
kiwamu@debian.or.jp**20130919151249
 Ignore-this: c4eda3e4cabfe4ec61288f9acc3916b4
] hunk ./src/Ho/ReadSource.hs 47
         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]
[Better NAIVEGC and new SAVING_MALLOC_HEAP flag.
kiwamu@debian.or.jp**20130919151344
 Ignore-this: 5f19fd33aa1f239b3d91c4dc587c022f
] hunk ./rts/rts/gc_jgc.c 24
 static bool s_set_used_bit(void *val) A_UNUSED;
 static void clear_used_bits(struct s_arena *arena) A_UNUSED;
 static void s_cleanup_blocks(struct s_arena *arena);
-static struct s_block *get_free_block(gc_t gc, struct s_arena *arena);
+static struct s_block *get_free_block(gc_t gc, struct s_arena *arena, bool retry);
 static void *jhc_aligned_alloc(unsigned size);
 
 typedef struct {
hunk ./rts/rts/gc_jgc.c 91
                 stack->stack[stack->ptr++] = s;
 }
 
+static void
+gc_mark_deeper(struct stack *stack, unsigned *number_redirects)
+{
+        while(stack->ptr) {
+                entry_t *e = stack->stack[--stack->ptr];
+                struct s_block *pg = S_BLOCK(e);
+                if(!(pg->flags & SLAB_MONOLITH))
+                        VALGRIND_MAKE_MEM_DEFINED(e,pg->u.pi.size * sizeof(uintptr_t));
+                debugf("Processing Grey: %p\n",e);
+                unsigned num_ptrs = pg->flags & SLAB_MONOLITH ? pg->u.m.num_ptrs : pg->u.pi.num_ptrs;
+                stack_check(stack, num_ptrs);
+                for(unsigned i = 0; i < num_ptrs; i++) {
+                        if(1 && (P_LAZY == GET_PTYPE(e->ptrs[i]))) {
+                                VALGRIND_MAKE_MEM_DEFINED(FROM_SPTR(e->ptrs[i]), sizeof(uintptr_t));
+                                if(!IS_LAZY(GETHEAD(FROM_SPTR(e->ptrs[i])))) {
+                                        *number_redirects++;
+                                        debugf(" *");
+                                        e->ptrs[i] = (sptr_t)GETHEAD(FROM_SPTR(e->ptrs[i]));
+                                }
+                        }
+                        if(IS_PTR(e->ptrs[i])) {
+                                entry_t * ptr = TO_GCPTR(e->ptrs[i]);
+                                debugf("Following: %p %p\n",e->ptrs[i], ptr);
+                                gc_add_grey(stack, ptr);
+                        }
+                }
+        }
+}
+
+#if defined(_JHC_JGC_SAVING_MALLOC_HEAP)
+#define DO_GC_MARK_DEEPER(S,N)  gc_mark_deeper((S),(N))
+#else
+#define DO_GC_MARK_DEEPER(S,N)  do { } while (/* CONSTCOND */ 0)
+#endif
+
 void A_STD
 gc_perform_gc(gc_t gc)
 {
hunk ./rts/rts/gc_jgc.c 144
         for(unsigned i = 0; i < root_stack.ptr; i++) {
                 gc_add_grey(&stack, root_stack.stack[i]);
                 debugf(" %p", root_stack.stack[i]);
+                DO_GC_MARK_DEEPER(&stack, &number_redirects);
         }
         debugf(" # ");
         struct StablePtr *sp;
hunk ./rts/rts/gc_jgc.c 150
         LIST_FOREACH(sp, &root_StablePtrs, link) {
             gc_add_grey(&stack, (entry_t *)sp);
-            debugf(" %p", root_stack.stack[i]);
+            debugf(" %p", sp);
+            DO_GC_MARK_DEEPER(&stack, &number_redirects);
         }
 
         debugf("\n");
hunk ./rts/rts/gc_jgc.c 156
         debugf("Trace:");
+#if defined(_JHC_JGC_SAVING_MALLOC_HEAP)
+        stack_check(&stack, 1); // Just alloc
+#else
         stack_check(&stack, gc - gc_stack_base);
hunk ./rts/rts/gc_jgc.c 160
+#endif
         number_stack = gc - gc_stack_base;
         for(unsigned i = 0; i < number_stack; i++) {
                 debugf(" |");
hunk ./rts/rts/gc_jgc.c 186
                 entry_t *e = TO_GCPTR(ptr);
                 debugf(" %p",(void *)e);
                 gc_add_grey(&stack, e);
+                DO_GC_MARK_DEEPER(&stack, &number_redirects);
         }
         debugf("\n");
 
hunk ./rts/rts/gc_jgc.c 190
-        while(stack.ptr) {
-                entry_t *e = stack.stack[--stack.ptr];
-                struct s_block *pg = S_BLOCK(e);
-                if(!(pg->flags & SLAB_MONOLITH))
-                        VALGRIND_MAKE_MEM_DEFINED(e,pg->u.pi.size * sizeof(uintptr_t));
-                debugf("Processing Grey: %p\n",e);
-                unsigned num_ptrs = pg->flags & SLAB_MONOLITH ? pg->u.m.num_ptrs : pg->u.pi.num_ptrs;
-                stack_check(&stack, num_ptrs);
-                for(unsigned i = 0; i < num_ptrs; i++) {
-                        if(1 && (P_LAZY == GET_PTYPE(e->ptrs[i]))) {
-                                VALGRIND_MAKE_MEM_DEFINED(FROM_SPTR(e->ptrs[i]), sizeof(uintptr_t));
-                                if(!IS_LAZY(GETHEAD(FROM_SPTR(e->ptrs[i])))) {
-                                        number_redirects++;
-                                        debugf(" *");
-                                        e->ptrs[i] = (sptr_t)GETHEAD(FROM_SPTR(e->ptrs[i]));
-                                }
-                        }
-                        if(IS_PTR(e->ptrs[i])) {
-                                entry_t * ptr = TO_GCPTR(e->ptrs[i]);
-                                debugf("Following: %p %p\n",e->ptrs[i], ptr);
-                                gc_add_grey( &stack, ptr);
-                        }
-                }
-        }
+        gc_mark_deeper(&stack, &number_redirects); // Final marking
         free(stack.stack);
         s_cleanup_blocks(arena);
         if (JHC_STATUS) {
hunk ./rts/rts/gc_jgc.c 369
 /* block allocator */
 
 static struct s_block *
-get_free_block(gc_t gc, struct s_arena *arena) {
+get_free_block(gc_t gc, struct s_arena *arena, bool retry) {
         arena->block_used++;
         if(__predict_true(SLIST_FIRST(&arena->free_blocks))) {
                 struct s_block *pg = SLIST_FIRST(&arena->free_blocks);
hunk ./rts/rts/gc_jgc.c 376
                 SLIST_REMOVE_HEAD(&arena->free_blocks,link);
                 return pg;
         } else {
-#ifndef _JHC_JGC_NAIVEGC
+#ifdef _JHC_JGC_NAIVEGC
+                if(retry == false) {
+                        gc_perform_gc(gc);
+                        return NULL;
+                }
+#else
                 if((arena->block_used >= arena->block_threshold)) {
                         gc_perform_gc(gc);
                         // if we are still using 80% of the heap after a gc, raise the threshold.
hunk ./rts/rts/gc_jgc.c 514
        sc->allocations++;
        sc->arena->number_allocs++;
 #endif
-        struct s_block *pg = SLIST_FIRST(&sc->blocks);
-#ifdef _JHC_JGC_NAIVEGC
+        bool retry = false;
+        struct s_block *pg;
+retry_s_alloc:
+        pg = SLIST_FIRST(&sc->blocks);
         if(__predict_false(!pg)) {
hunk ./rts/rts/gc_jgc.c 519
-                gc_perform_gc(gc);
-        }
-#endif
-        if(__predict_false(!pg)) {
-                pg = get_free_block(gc, sc->arena);
+                pg = get_free_block(gc, sc->arena, retry);
+                if(__predict_false(!pg)) {
+                        retry = true;
+                        goto retry_s_alloc;
+                }
                 VALGRIND_MAKE_MEM_NOACCESS(pg, BLOCK_SIZE);
                 VALGRIND_MAKE_MEM_DEFINED(pg, sizeof(struct s_block));
                 if(sc->num_entries != pg->u.pi.num_free)