[redo organization of the rts, sanify treatment of feature macros, make all executables contain basic profiling code which is enabled by setting the env variable JHC_RTS_PROFILE
John Meacham <john@repetae.net>**20070302053124] hunk ./C/FromGrin.hs 30
-import RawFiles(hsffi_h,jhc_rts_c)
+import RawFiles(hsffi_h,jhc_rts_header_h,jhc_rts_alloc_c,jhc_rts_c)
hunk ./C/FromGrin.hs 58
-profile_update_inc = expr $ functionCall (name "update_inc") []
-profile_case_inc = expr $ functionCall (name "case_inc") []
-profile_function_inc = expr $ functionCall (name "function_inc") []
+profile_update_inc = expr $ functionCall (name "jhc_update_inc") []
+profile_case_inc = expr $ functionCall (name "jhc_case_inc") []
+profile_function_inc = expr $ functionCall (name "jhc_function_inc") []
hunk ./C/FromGrin.hs 473
-compileGrin grin = (hsffi_h ++ jhc_rts_c ++ "\ntypedef union node node_t;\n" ++ P.render ans ++ "\n", snub (reqLibraries req))  where
+compileGrin grin = (hsffi_h ++ jhc_rts_header_h ++ jhc_rts_alloc_c ++ jhc_rts_c ++ "\ntypedef union node node_t;\n" ++ P.render ans ++ "\n", snub (reqLibraries req))  where
hunk ./C/FromGrin2.hs 80
-compileGrin grin = (hsffi_h ++ jhc_rts_c ++ jhc_rts2_c ++ P.render ans ++ "\n", snub (reqLibraries req))  where
+compileGrin grin = (hsffi_h ++ jhc_rts_header_h ++ jhc_rts_alloc_c ++ jhc_rts_c ++ jhc_rts2_c ++ P.render ans ++ "\n", snub (reqLibraries req))  where
hunk ./C/FromGrin2.hs 638
-profile_update_inc   = expr $ functionCall (name "update_inc") []
-profile_case_inc     = expr $ functionCall (name "case_inc") []
-profile_function_inc = expr $ functionCall (name "function_inc") []
+profile_update_inc   = expr $ functionCall (name "jhc_update_inc") []
+profile_case_inc     = expr $ functionCall (name "jhc_case_inc") []
+profile_function_inc = expr $ functionCall (name "jhc_function_inc") []
hunk ./Main.hs 801
-        boehmOpts | fopts FO.Boehm = ["-DUSE_BOEHM_GC", "-lgc"]
+        boehmOpts | fopts FO.Boehm = ["-D_JHC_BOEHM_GC=1", "-lgc"]
hunk ./Main.hs 803
-        profileOpts | fopts FO.Profile = ["-D_JHC_PROFILE"]
+        profileOpts | fopts FO.Profile = ["-D_JHC_PROFILE=1"]
hunk ./Makefile 140
-RawFiles.hs:  data/HsFFI.h data/jhc_rts.c data/jhc_rts2.c data/ViaGhc.hs
+RawFiles.hs:  data/HsFFI.h data/jhc_rts.c data/jhc_rts_header.h data/wsize.h data/jhc_rts_alloc.c data/jhc_rts2.c data/ViaGhc.hs
hunk ./data/HsFFI.h 3
+#ifndef _JHC_HSFFI_H
+#define _JHC_HSFFI_H
+
hunk ./data/HsFFI.h 35
+#endif
hunk ./data/HsFFI.h 37
-
hunk ./data/jhc_rts.c 1
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <unistd.h>
-#include <wchar.h>
-#include <limits.h>
-#include <locale.h>
-#include <math.h>
-#include <float.h>
-#include <setjmp.h>
-
-#ifdef USE_BOEHM_GC
-#include <gc/gc.h>
-#define jhc_malloc GC_malloc
-#define jhc_malloc_atomic GC_malloc_atomic
-#define jhc_free GC_free
-#endif
-
-
-#ifdef __GNUC__
-#define A_NORETURN __attribute__ ((noreturn))
-#define A_PURE __attribute__ ((pure))
-#define A_CONST __attribute__ ((const))
-#define A_UNUSED __attribute__ ((unused))
-#define A_MALLOC __attribute__ ((malloc))
-#define A_MAYALIAS __attribute__ ((__may_alias__))
-#ifdef __i386__
-#define A_REGPARM __attribute__ ((fastcall))
-#else
-#define A_REGPARM
-#endif
-#define A_STD    A_REGPARM
-
-
-#else
-#define A_MAYALIAS
-#define A_NORETURN
-#define A_PURE
-#define A_CONST
-#define A_UNUSED
-#define A_MALLOC
-#define A_STD
-#endif
-
-
-#define STR(s) #s
-#define XSTR(s) STR(s)
-#define ALIGN(a,n) ((n) - 1 + ((a) - ((n) - 1) % (a)))
hunk ./data/jhc_rts.c 10
-#ifdef _JHC_PROFILE
-static uintmax_t prof_function_calls;
-static uintmax_t prof_case_statements;
-static uintmax_t prof_updates;
-#ifndef USE_BOEHM_GC
-static void *prof_memstart;
-#endif
-
-#define update_inc() prof_updates++
-#define function_inc() prof_function_calls++
-#define case_inc() prof_case_statements++
-#else
-#define update_inc()  do { } while(0)
-#define function_inc()  do { } while(0)
-#define case_inc()  do { } while(0)
-#endif
-
-
-#ifndef USE_BOEHM_GC
-static void *jhc_mem = NULL;
-
-#ifndef NDEBUG
+#if _JHC_PROFILE
hunk ./data/jhc_rts.c 12
-#define jhc_malloc(n) jhc_malloc_debug(n,__LINE__)
+static uintmax_t jhc_prof_function_calls;
+static uintmax_t jhc_prof_case_statements;
+static uintmax_t jhc_prof_updates;
hunk ./data/jhc_rts.c 16
-static inline void * A_MALLOC
-jhc_malloc_debug(size_t n,int line)
-{
-        void *ret = jhc_mem;
-        jhc_mem += ALIGN(__alignof__(void *),sizeof(uintptr_t) + n);
-        *((uintptr_t *)ret) = line;
-//        memset(ret,7,(char *)jhc_mem - (char *)ret);
-//        memset(jhc_mem,8,2*sizeof(void *));
-        return ret + sizeof(uintptr_t);
-}
+#define jhc_update_inc()   jhc_prof_updates++
+#define jhc_function_inc() jhc_prof_function_calls++
+#define jhc_case_inc()     jhc_prof_case_statements++
hunk ./data/jhc_rts.c 22
-static inline void * A_MALLOC
-jhc_malloc(size_t n)
-{
-        void *ret = jhc_mem;
-        jhc_mem += ALIGN(__alignof__(void *),n);
-        return ret;
-}
-
-#endif
-
-#define jhc_malloc_atomic(x) jhc_malloc(x)
+#define jhc_update_inc()    do { } while(0)
+#define jhc_function_inc()  do { } while(0)
+#define jhc_case_inc()      do { } while(0)
hunk ./data/jhc_rts.c 30
-#ifdef _JHC_PROFILE
-        wprintf(L"Command: %s\n", jhc_command);
-#ifndef USE_BOEHM_GC
-        wprintf(L"Memory Allocated: %llu\n", (long long)(jhc_mem - prof_memstart));
+        struct tms tm;
+        times(&tm);
+        if(!(_JHC_PROFILE || getenv("JHC_RTS_PROFILE"))) return;
+
+        fwprintf(stderr, L"\n-----------------\n");
+        fwprintf(stderr, L"Profiling: %s\n", jhc_progname);
+        fwprintf(stderr, L"Command: %s\n", jhc_command);
+        fwprintf(stderr, L"Complie: %s\n", jhc_c_compile);
+        fwprintf(stderr, L"Version: %s\n\n", jhc_version);
+#if !_JHC_BOEHM_GC
+        fwprintf(stderr, L"Memory Allocated: %llu bytes\n", (unsigned long long)(jhc_mem - jhc_memstart));
hunk ./data/jhc_rts.c 42
-        wprintf(L"Function Calls:   %llu\n", (long long)prof_function_calls);
-        wprintf(L"Case Statements:  %llu\n", (long long)prof_case_statements);
-        wprintf(L"Updates:          %llu\n", (long long)prof_updates);
+        float cpt = (float)sysconf(_SC_CLK_TCK);
+        fwprintf(stderr, L"User Time:   %.2fs\n", (float)tm.tms_utime/cpt);
+        fwprintf(stderr, L"System Time: %.2fs\n", (float)tm.tms_stime/cpt);
+        fwprintf(stderr, L"Total Time:  %.2fs\n", (float)(tm.tms_stime + tm.tms_utime)/cpt);
+
+#if _JHC_PROFILE
+        fwprintf(stderr, L"\nFunction Calls:   %llu\n", (unsigned long long)jhc_prof_function_calls);
+        fwprintf(stderr, L"Case Statements:  %llu\n", (unsigned long long)jhc_prof_case_statements);
+        fwprintf(stderr, L"Updates:          %llu\n", (unsigned long long)jhc_prof_updates);
hunk ./data/jhc_rts.c 52
+        fwprintf(stderr, L"-----------------\n");
hunk ./data/jhc_rts.c 70
+#if _JHC_DEBUG
hunk ./data/jhc_rts.c 77
+#else
+
+#define jhc_case_fell_off(x) do {} while(0)
+
+#endif
hunk ./data/jhc_rts.c 92
-
hunk ./data/jhc_rts.c 95
-#ifndef USE_BOEHM_GC
-        size_t mem_size = 1000000000;
-        while(!jhc_mem) {
-                jhc_mem = malloc(mem_size);
-                mem_size *= 0.80;
-        }
-#ifdef _JHC_PROFILE
-        prof_memstart = jhc_mem;
-#endif
-#else
-        GC_INIT()
-#endif
-
+        jhc_malloc_init();
hunk ./data/jhc_rts.c 108
-
hunk ./data/jhc_rts2.c 99
-#ifndef NDEBUG
+#if _JHC_DEBUG
hunk ./data/jhc_rts2.c 140
-#ifndef NDEBUG
+#if _JHC_DEBUG
hunk ./data/jhc_rts2.c 144
-#ifndef NDEBUG
+#if _JHC_DEBUG
hunk ./data/jhc_rts2.c 158
-        update_inc();
+        jhc_update_inc();
addfile ./data/jhc_rts_alloc.c
hunk ./data/jhc_rts_alloc.c 1
+
+#if   _JHC_BOEHM_GC
+
+#include <gc/gc.h>
+#define jhc_malloc GC_malloc
+#define jhc_malloc_whnf GC_malloc
+#define jhc_malloc_suspension GC_malloc
+#define jhc_malloc_atomic GC_malloc_atomic
+#define jhc_malloc_atomic_whnf GC_malloc_atomic
+#define jhc_free GC_free
+
+static inline void
+jhc_malloc_init(void)
+{
+        GC_INIT();
+}
+
+#else
+
+static void *jhc_mem = NULL;
+static void *jhc_memstart;
+
+
+static inline void
+jhc_malloc_init(void)
+{
+        size_t mem_size = 1000000000;
+        while(!jhc_mem) {
+                jhc_mem = malloc(mem_size);
+                mem_size *= 0.80;
+        }
+        jhc_memstart = jhc_mem;
+}
+
+
+#if _JHC_DEBUG
+
+struct jhcm_header {
+        unsigned short line_number;
+};
+
+#define jhc_malloc(n) jhc_malloc_debug(n,__LINE__)
+
+static inline void * A_MALLOC
+jhc_malloc_debug(size_t n,int line)
+{
+        void *ret = jhc_mem;
+        jhc_mem += ALIGN(__alignof__(void *),sizeof(uintptr_t) + n);
+        *((uintptr_t *)ret) = line;
+        return ret + sizeof(uintptr_t);
+}
+
+#else
+
+static inline void * A_MALLOC
+jhc_malloc(size_t n)
+{
+        void *ret = jhc_mem;
+        jhc_mem += ALIGN(__alignof__(void *),n);
+        return ret;
+}
+
+#endif
+
+#define jhc_malloc_atomic(x)      jhc_malloc(x)
+#define jhc_malloc_atomic_whnf(x) jhc_malloc(x)
+#define jhc_malloc_whnf(x)        jhc_malloc(x)
+#define jhc_malloc_suspension(x)  jhc_malloc(x)
+
+
+#endif // USE_BOEHM_GC
+
+
+
addfile ./data/jhc_rts_header.h
hunk ./data/jhc_rts_header.h 1
+
+// jhc_rts_header.h
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+#include <wchar.h>
+#include <limits.h>
+#include <locale.h>
+#include <math.h>
+#include <float.h>
+#include <sys/times.h>
+#include <setjmp.h>
+
+
+// #define our options
+
+#ifndef _JHC_BOEHM_GC
+#define _JHC_BOEHM_GC 0
+#endif
+
+#ifndef _JHC_PROFILE
+#define _JHC_PROFILE 0
+#endif
+
+#ifndef _JHC_DEBUG
+#ifdef NDEBUG
+#define _JHC_DEBUG 0
+#else
+#define _JHC_DEBUG 1
+#endif
+#endif
+
+
+// GNU attributes
+
+#ifdef __GNUC__
+#define A_NORETURN __attribute__ ((noreturn))
+#define A_PURE __attribute__ ((pure))
+#define A_CONST __attribute__ ((const))
+#define A_UNUSED __attribute__ ((unused))
+#define A_MALLOC __attribute__ ((malloc))
+#define A_MAYALIAS __attribute__ ((__may_alias__))
+#ifdef __i386__
+#define A_REGPARM __attribute__ ((fastcall))
+#else
+#define A_REGPARM
+#endif
+#define A_STD    A_REGPARM
+
+#else
+#define A_MAYALIAS
+#define A_NORETURN
+#define A_PURE
+#define A_CONST
+#define A_UNUSED
+#define A_MALLOC
+#define A_STD
+#endif
+
+
+#define STR(s) #s
+#define XSTR(s) STR(s)
+#define ALIGN(a,n) ((n) - 1 + ((a) - ((n) - 1) % (a)))
+
+
+
addfile ./data/wsize.h
hunk ./data/wsize.h 1
+#ifndef WSIZE_H
+#define WSIZE_H
+
+/*
+ * wsize.h
+ * define appropriate __WORDSIZE and __BYTE_ORDER macros
+ *
+ * always use operating systems headers rather than checking for architectures
+ * when possible. if adding new cases. Checking the CPU type should be a last
+ * resort.
+ *
+ */
+
+#include <limits.h>
+
+#ifdef __linux__
+#include<endian.h>
+#endif
+
+#ifndef __LITTLE_ENDIAN
+#define	__LITTLE_ENDIAN	1234
+#endif
+#ifndef __BIG_ENDIAN
+#define	__BIG_ENDIAN	4321
+#endif
+#ifndef __PDP_ENDIAN
+#define	__PDP_ENDIAN	3412
+#endif
+
+#ifndef __BYTE_ORDER
+#ifdef _BIG_ENDIAN
+#define __BYTE_ORDER __BIG_ENDIAN
+#elif defined(_LITTLE_ENDIAN)
+#define __BYTE_ORDER __LITTLE_ENDIAN
+#elif defined(__i386__)
+#define __BYTE_ORDER __LITTLE_ENDIAN
+#else
+#error Could not determine Byte Order
+#endif
+#endif
+
+#ifndef __WORDSIZE
+#ifdef WORD_BIT
+#define __WORDSIZE WORD_BIT
+#elif defined(__i386__)
+#define __WORDSIZE 32
+#elif defined(__x86_64__)
+#define __WORDSIZE 64
+#else
+#error Could not determine bitsize
+#endif
+
+#endif
+
+
+#ifdef TEST_WSIZE
+#include <stdio.h>
+int
+main(int argc, char *argv[])
+{
+    printf("__WORDSIZE:   %i\n", __WORDSIZE);
+    printf("__BYTE_ORDER: %i\n", __BYTE_ORDER);
+    return 0;
+}
+#endif
+
+#endif