Asg
Threads by month
- ----- 2026 -----
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2025 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
August 2012
- 18 participants
- 63 discussions
1
0
I won't be able to attend the weekly concal (I have a monthly recurring
conflict).
Dries
1
0
20 Aug '12
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "".
The branch, master has been updated
via d966b4248a2a517a58bef97358a46e63f95a5b0e (commit)
from 2e1e06c8c9d9c19a44f7e60f8fb7e6a219cb6308 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit d966b4248a2a517a58bef97358a46e63f95a5b0e
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 14:28:21 2012 -0400
fix buggy use of ae_main_set_with_init() in tests
-----------------------------------------------------------------------
Summary of changes:
tests/blocking-overhead.ae | 2 +-
tests/test-hints.ae | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
Diff of changes:
diff --git a/tests/blocking-overhead.ae b/tests/blocking-overhead.ae
index 4843a13..2fc3edc 100644
--- a/tests/blocking-overhead.ae
+++ b/tests/blocking-overhead.ae
@@ -134,7 +134,7 @@ __blocking int aesop_main(int argc, char **argv)
}
-aesop_main_set_with_init(NULL, "timer", aesop_main, "timer");
+aesop_main_set(aesop_main);
/*
* Local variables:
diff --git a/tests/test-hints.ae b/tests/test-hints.ae
index 083508e..96d4678 100644
--- a/tests/test-hints.ae
+++ b/tests/test-hints.ae
@@ -56,7 +56,7 @@ __blocking int aesop_main(int argc, char **argv)
return 0;
}
-aesop_main_set_with_init(NULL, "timer", aesop_main, "timer");
+aesop_main_set(aesop_main);
/*
* Local variables:
hooks/post-receive
--
1
0
20 Aug '12
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "".
The branch, master has been updated
via 2e1e06c8c9d9c19a44f7e60f8fb7e6a219cb6308 (commit)
via 9ac61f9520b55792fb7b1e4a9f2017fc9225eb69 (commit)
via c9cebb949ebc7d482224453483de074bd0bc9241 (commit)
via fc530449b754ebe9f3478f4a4569765832614f37 (commit)
via 055b110ccf7430bfc0cf793db79790bb9705212b (commit)
via 5784d8b4f6b037a04b5d32d734864a2af60d4a34 (commit)
via 569b2642fb70caeac542a52cc80b53641ab99aa0 (commit)
via a16e1412cdc681e8c07f529e230d4f616e983d3f (commit)
via d5385faa8d300ab089f4764516dd2a138d8196f9 (commit)
via 8740224ab1d8561b688d1c53405961922511c9b4 (commit)
from a5b7b6f7d83a0e7b02abf7fe105d0956749e35af (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 2e1e06c8c9d9c19a44f7e60f8fb7e6a219cb6308
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 14:10:22 2012 -0400
ae-blocking-parser header warnings
commit 9ac61f9520b55792fb7b1e4a9f2017fc9225eb69
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:58:17 2012 -0400
ae-init warnings
commit c9cebb949ebc7d482224453483de074bd0bc9241
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:57:40 2012 -0400
hints warnings
commit fc530449b754ebe9f3478f4a4569765832614f37
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:53:31 2012 -0400
resource.c warnings
commit 055b110ccf7430bfc0cf793db79790bb9705212b
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:52:56 2012 -0400
resourcebuilder warnings
commit 5784d8b4f6b037a04b5d32d734864a2af60d4a34
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:50:59 2012 -0400
fix timer warnings
commit 569b2642fb70caeac542a52cc80b53641ab99aa0
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:48:43 2012 -0400
fix aethread warnings
commit a16e1412cdc681e8c07f529e230d4f616e983d3f
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:46:39 2012 -0400
update c-utils submodule to newest version
commit d5385faa8d300ab089f4764516dd2a138d8196f9
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:33:37 2012 -0400
fix warnings
commit 8740224ab1d8561b688d1c53405961922511c9b4
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Mon Aug 20 13:33:17 2012 -0400
fix warnings in clang label workaround
-----------------------------------------------------------------------
Summary of changes:
ae-blocking-parser.h | 3 +--
ae-init.c | 2 ++
hints.c | 6 ++----
hints.h | 2 ++
resource.c | 5 ++---
resources/resourcebuilder/resourcebuilder.c | 5 ++---
resources/thread/aethread.c | 6 +-----
resources/timer/timer.c | 5 -----
src/c-utils | 2 +-
src/socket/aesocket.ae | 4 +++-
10 files changed, 16 insertions(+), 24 deletions(-)
Diff of changes:
diff --git a/ae-blocking-parser.h b/ae-blocking-parser.h
index 21855a6..6ddfa60 100644
--- a/ae-blocking-parser.h
+++ b/ae-blocking-parser.h
@@ -208,6 +208,7 @@ fake_label_to_please_clang: \
if(*__ae_state == AE_CTL_CALL_COMPLETE) \
{ \
void* foo = &&fake_label_to_please_clang; \
+ (void)foo; \
assert(__ae_ctl->gen.state_label); \
goto *__ae_ctl->gen.state_label; \
}
@@ -612,8 +613,6 @@ __ae_pbranch_##__pbranch_pos_str##_after: {}
\
__fname##_immediate_completion: \
{ \
- void (* __ae_local_cb)(void *); \
- AE_MK_DONE_DECLS(); \
AE_MK_END_OF_BLOCKING(__fname, " (IC)"); \
ae_debug_pbranch("ctl_done: bfun ic: %p\n", __ae_ctl); \
ae_ctl_done(&__ae_ctl->gen); \
diff --git a/ae-init.c b/ae-init.c
index f1df2e9..8b35bea 100644
--- a/ae-init.c
+++ b/ae-init.c
@@ -14,6 +14,8 @@ int ae_init (void)
/* Call the constructor functions here */
aesop_timer_init_register ();
triton_aethread_init_register ();
+
+ return(0);
}
/*
diff --git a/hints.c b/hints.c
index 069e43d..5c96bf8 100644
--- a/hints.c
+++ b/hints.c
@@ -228,7 +228,6 @@ int ae_hints_del(ae_hints_t *hints, const char *key)
struct ae_hint_info *info;
struct ae_hint_entry *entry, *tmpentry;
- int ret;
info = ae_hints_get_info_by_key(key);
if(!info)
@@ -266,7 +265,6 @@ int ae_hints_modify(ae_hints_t * hints,
struct ae_hint_info *info;
struct ae_hint_entry *entry, *tmpentry;
- int ret;
info = ae_hints_get_info_by_key(key);
if(!info)
@@ -384,7 +382,6 @@ int ae_hints_get(ae_hints_t *hints,
{
struct ae_hint_entry *entry, *tmpentry;
struct ae_hint_info *info;
- ae_hints_t *p;
assert(hints);
@@ -544,6 +541,7 @@ done:
return ret;
}
+#if 0
int ae_hints_check(ae_hints_t *hints, int type)
{
struct ae_hint_entry *entry, *tmpentry;
@@ -564,7 +562,6 @@ int ae_hints_check(ae_hints_t *hints, int type)
static uint32_t count_transferable_hints(struct ae_hints *h)
{
uint64_t count = 0;
- struct ae_hints_entry *entry, *tmpentry;
while(h)
{
@@ -573,6 +570,7 @@ static uint32_t count_transferable_hints(struct ae_hints *h)
}
return count;
}
+#endif
/*
* Local variables:
diff --git a/hints.h b/hints.h
index 6497e44..5c8d8c3 100644
--- a/hints.h
+++ b/hints.h
@@ -110,10 +110,12 @@ int ae_hints_clone(ae_hints_t *oldh, ae_hints_t ** newh);
*/
int ae_hints_dup(ae_hints_t *oldh, ae_hints_t ** newh);
+#if 0
/**
* Check that hints hold a value for a particular hint type.
*/
int ae_hints_check(ae_hints_t *hints, int type);
+#endif
/**
* Initialize members of hint structure.
diff --git a/resource.c b/resource.c
index e3addcb..7c3efd6 100644
--- a/resource.c
+++ b/resource.c
@@ -156,7 +156,6 @@ int ae_resource_register_with_data(struct ae_resource *resource, int *newid,
void *user_data)
{
int reindex = -1;
- int ret;
int i;
if(ae_resource_count == 0)
@@ -565,8 +564,6 @@ static void timeout_cb(EV_P_ ev_timer *w, int revents)
int ae_poll(ae_context_t context, int millisecs)
{
struct ev_loop* target_loop;
- int ret;
- int i;
ev_timer timeout;
int hit_timeout = 0;
@@ -1012,6 +1009,8 @@ int ae_resource_cleanup (void)
ae_resource_init_register_cleanup ();
ev_async_stop (eloop, &eloop_breaker);
ev_default_destroy ();
+
+ return(0);
}
/*
diff --git a/resources/resourcebuilder/resourcebuilder.c b/resources/resourcebuilder/resourcebuilder.c
index d7f062c..4f22420 100644
--- a/resources/resourcebuilder/resourcebuilder.c
+++ b/resources/resourcebuilder/resourcebuilder.c
@@ -124,7 +124,7 @@ static int rb_callback (rb_slot_t * slot, int success)
return AE_ERR_NOT_FOUND;
}
- if (status == STATUS_COMPLETED_SUCCESS | status == STATUS_COMPLETED_CANCEL)
+ if (status == STATUS_COMPLETED_SUCCESS || status == STATUS_COMPLETED_CANCEL)
{
/* was already completed */
return AE_ERR_INVALID;
@@ -136,7 +136,6 @@ static int rb_callback (rb_slot_t * slot, int success)
/* some internal checks */
int resource_id;
- struct ae_op * op = &slot->op;
assert (slot == (rb_slot_t *) intptr2op (ae_id_lookup (slot->op_id,
&resource_id)));
@@ -181,7 +180,7 @@ void rb_slot_destroy (rb_slot_t * slot)
{
/* make sure the slot has been properly completed (or cancelled) */
const int status = OPA_load_int (&slot->status);
- assert (status == STATUS_COMPLETED_CANCEL |
+ assert (status == STATUS_COMPLETED_CANCEL ||
status == STATUS_COMPLETED_SUCCESS);
OPA_store_int (&slot->status, STATUS_UNINITIALIZED);
}
diff --git a/resources/thread/aethread.c b/resources/thread/aethread.c
index 1f693a6..2252554 100644
--- a/resources/thread/aethread.c
+++ b/resources/thread/aethread.c
@@ -165,9 +165,6 @@ ae_define_post(int, aethread_hint, struct aethread_group *group)
{
struct ae_op *op;
struct aethread_op *a_op;
- pthread_t tid;
- pthread_attr_t attr;
- int ret;
assert(initialized && group);
@@ -198,7 +195,7 @@ ae_define_post(int, aethread_hint, struct aethread_group *group)
return AE_SUCCESS;
}
-static int triton_aethread_poll(ae_context_t context)
+static int triton_aethread_poll(ae_context_t context, void *user_data)
{
return AE_SUCCESS;
}
@@ -208,7 +205,6 @@ static int triton_aethread_cancel(ae_context_t triton_ctx, ae_op_id_t op_id)
int resource_id;
struct ae_op *op;
struct aethread_op *aop;
- ae_context_t ctx;
struct aethread_group *group, *tmpgroup;
int found = 0;
diff --git a/resources/timer/timer.c b/resources/timer/timer.c
index adc6147..4e66d4c 100644
--- a/resources/timer/timer.c
+++ b/resources/timer/timer.c
@@ -54,7 +54,6 @@ static ae_ops_t cancel_oplist;
ae_define_post(int, aesop_timer, int millisecs)
{
struct timeval adjust, now;
- int ret;
struct timer_op *top;
struct ae_op *op;
struct ae_op *iter, *safe, *holder;
@@ -265,9 +264,6 @@ static void timer_cb(EV_P_ ev_timer *w, int revents)
struct timer_op *top;
struct timeval now;
struct timeval diff;
- int did_something = 0;
- ae_context_t ctx;
- int ret;
ev_tstamp tstamp;
triton_mutex_lock(&timer_mutex);
@@ -285,7 +281,6 @@ static void timer_cb(EV_P_ ev_timer *w, int revents)
top = ae_op_entry(gop, struct timer_op, op);
triton_mutex_unlock(&timer_mutex);
- ctx = gop->ctx;
ae_opcache_complete_op(timer_opcache, gop, int, 0);
/* setup for next iteration */
triton_mutex_lock(&timer_mutex);
diff --git a/src/c-utils b/src/c-utils
index 8b480ad..13204b3 160000
--- a/src/c-utils
+++ b/src/c-utils
@@ -1 +1 @@
-Subproject commit 8b480ad06f857dfecd8aaa809704df97281378c0
+Subproject commit 13204b325870a1f4f9c5317f9d93f2d54c6725c6
diff --git a/src/socket/aesocket.ae b/src/socket/aesocket.ae
index 0dd205f..d989b92 100644
--- a/src/socket/aesocket.ae
+++ b/src/socket/aesocket.ae
@@ -100,6 +100,8 @@ static void * aesocket_thread_main (void * arg)
aesocket_check_queue ();
ev_loop (socket_ev_loop, EVLOOP_ONESHOT);
}
+
+ return(NULL);
}
int aesocket_init (void)
@@ -232,7 +234,7 @@ __blocking int aesocket_ready (int fd, int flags, int * err)
rb_slot_destroy (&entry.slot);
*err = 0;
- return ret;
+ return(ret);
}
hooks/post-receive
--
1
0
The last commit to the aesop repository added fixes for newer versions
of GHC and Language.C.
The older version of ghc is *no longer supported*.
Please make sure to have at least version 7 of ghc.
In addition, the aesop installation scripts are now using cabal to install
dependencies. (See the README.txt in the aesop repository).
Thanks,
Dries
1
0
18 Aug '12
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "".
The branch, master has been updated
via a5b7b6f7d83a0e7b02abf7fe105d0956749e35af (commit)
via 03d81d471ecf6f1f2de7b22cc5b7d9adc825f39b (commit)
via bfb2d7f150319e2362c50f1ebb2fdc5cb282a0af (commit)
via c47037915413306aedfeb3600648a7b510315221 (commit)
via 562e89f0d8170f88ff50d01ca9b21c10a3def577 (commit)
via 8904fe5ef7e6dc5e93cea423b975fb30482fdc4b (commit)
via 76e8fde58a72a47e0792caacbb3cde9fd5130a96 (commit)
via f3b7b9e9dbe3b73756e25853a934c4a3c1ebda32 (commit)
via 9efea99af4bfcf52e839a57bbca4381a0173af17 (commit)
via 644552de7006e7b98b07e725e6870c6b6bb61459 (commit)
via 07a81d9d0bf72cd8fc8cb61e1da9349142e49c6b (commit)
from c420e93e6e45b908282b3406a8a80ce8657f69ed (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a5b7b6f7d83a0e7b02abf7fe105d0956749e35af
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Sat Aug 18 16:23:58 2012 -0500
Remove old language-c archive
commit 03d81d471ecf6f1f2de7b22cc5b7d9adc825f39b
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Sat Aug 18 16:24:39 2012 -0500
Fix tabs in ae-blocking-parser.lhs
commit bfb2d7f150319e2362c50f1ebb2fdc5cb282a0af
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Sat Aug 18 16:22:32 2012 -0500
Languate-c-0.4.2 patch
commit c47037915413306aedfeb3600648a7b510315221
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Sat Aug 18 16:23:07 2012 -0500
Don't refetch files if they already exist
commit 562e89f0d8170f88ff50d01ca9b21c10a3def577
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Sat Aug 18 16:20:21 2012 -0500
Fix setup-aesop script
(Was failing when executed without absolute path)
commit 8904fe5ef7e6dc5e93cea423b975fb30482fdc4b
Author: Justin M Wozniak <wozniak(a)mcs.anl.gov>
Date: Tue Jul 3 10:31:37 2012 -0500
Aesop parser fix for test err-untyped-func
commit 76e8fde58a72a47e0792caacbb3cde9fd5130a96
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Fri Jun 8 10:38:52 2012 -0400
fix typo in aesop README.txt
commit f3b7b9e9dbe3b73756e25853a934c4a3c1ebda32
Author: Justin M Wozniak <wozniak(a)mcs.anl.gov>
Date: Tue Jun 5 10:21:03 2012 -0500
Additional usage note
commit 9efea99af4bfcf52e839a57bbca4381a0173af17
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Fri Aug 17 16:24:10 2012 -0500
triton: d09d2770030f86662ef5ce7f8f12b3426eccb2f6
Port from triton tree
commit 644552de7006e7b98b07e725e6870c6b6bb61459
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Fri Aug 17 15:58:21 2012 -0500
Initial application of Sam's patch
triton: 391b9dc071ae7d788fc5e164775b157a6595d040
commit 07a81d9d0bf72cd8fc8cb61e1da9349142e49c6b
Author: Dries Kimpe <dkimpe(a)mcs.anl.gov>
Date: Fri Aug 17 15:33:01 2012 -0500
Update aesop to latest c-utils
-----------------------------------------------------------------------
Summary of changes:
Makefile.in | 2 +-
maint/hs/README.txt | 2 +
.../{language-c.patch => language-c-0.4.2.patch} | 214 +++----
maint/hs/language-c-0.4.tar.gz | Bin 108164 -> 0 bytes
maint/hs/setup-aesop | 53 ++
maint/hs/setup-cabal-local | 11 +
maint/hs/setup-hs-local | 77 +--
maint/hs/setup-langc | 51 --
parser/CGen.lhs | 2 +-
parser/CParse.lhs | 24 +-
parser/Walker.lhs | 2 +-
parser/ae-blocking-parser.lhs | 655 ++++++++++----------
src/aesop/parser/README.txt | 31 +
src/c-utils | 2 +-
14 files changed, 569 insertions(+), 557 deletions(-)
create mode 100644 maint/hs/README.txt
copy maint/hs/{language-c.patch => language-c-0.4.2.patch} (68%)
delete mode 100644 maint/hs/language-c-0.4.tar.gz
create mode 100755 maint/hs/setup-aesop
create mode 100755 maint/hs/setup-cabal-local
delete mode 100755 maint/hs/setup-langc
create mode 100644 src/aesop/parser/README.txt
Diff of changes:
diff --git a/Makefile.in b/Makefile.in
index 6eeee2e..efb48a1 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -540,7 +540,7 @@ $(HSBIN): %: $(srcdir)/%.lhs $(HSSRC)
-hidir $(call canonname,$<) \
-o $@ \
-main-is $(call modname,$<) \
- -i$(call dir,$<) --make $< >/dev/null
+ -i$(call dir,$<) --make -XFlexibleInstances $< >/dev/null
# User targets
diff --git a/maint/hs/README.txt b/maint/hs/README.txt
new file mode 100644
index 0000000..53b70c0
--- /dev/null
+++ b/maint/hs/README.txt
@@ -0,0 +1,2 @@
+
+See src/aesop/parser/README.txt
diff --git a/maint/hs/language-c.patch b/maint/hs/language-c-0.4.2.patch
similarity index 68%
copy from maint/hs/language-c.patch
copy to maint/hs/language-c-0.4.2.patch
index fffc133..77dfc24 100644
--- a/maint/hs/language-c.patch
+++ b/maint/hs/language-c-0.4.2.patch
@@ -1,11 +1,11 @@
-diff -Naur language-c-0.4/language-c.cabal language-c-0.4-new/language-c.cabal
---- language-c-0.4/language-c.cabal 2011-01-06 11:46:35.000000000 -0600
-+++ language-c-0.4-new/language-c.cabal 2011-01-06 15:31:57.629238232 -0600
+diff -Naur language-c-0.4.2/language-c.cabal language-c-0.4.2-new/language-c.cabal
+--- language-c-0.4.2/language-c.cabal 2011-08-24 09:51:22.000000000 -0500
++++ language-c-0.4.2-new/language-c.cabal 2012-05-26 11:43:57.893087938 -0500
@@ -1,4 +1,4 @@
-Name: language-c
+Name: language-aesop
- Version: 0.4
- Cabal-Version: >= 1.2
+ Version: 0.4.2
+ Cabal-Version: >= 1.6
Build-Type: Simple
@@ -6,7 +6,7 @@
License-File: LICENSE
@@ -16,25 +16,17 @@ diff -Naur language-c-0.4/language-c.cabal language-c-0.4-new/language-c.cabal
Stability: experimental
Homepage: http://www.sivity.net/projects/language.c/
Bug-reports: http://www.sivity.net/projects/language.c/
-@@ -14,6 +14,7 @@
+@@ -15,6 +15,7 @@
Description: Language C is a haskell library for the analysis and generation of C code.
It features a complete, well tested parser and pretty printer for all of C99 and a large
set of GNU extensions.
+ This modified version includes extensions for AESOP.
Category: Language
-
+
Extra-Source-Files: AUTHORS AUTHORS.c2hs ChangeLog README
-@@ -48,7 +49,6 @@
- Build-Depends: bytestring >= 0.9.0
- else
- cpp-options: -DNO_BYTESTRING
-- Build-Tools: happy, alex
-
- Hs-Source-Dirs: src
- Exposed-Modules:
-diff -Naur language-c-0.4/src/Language/C/Data/Ident.hs language-c-0.4-new/src/Language/C/Data/Ident.hs
---- language-c-0.4/src/Language/C/Data/Ident.hs 2011-01-06 11:46:35.000000000 -0600
-+++ language-c-0.4-new/src/Language/C/Data/Ident.hs 2011-01-06 15:31:57.632007216 -0600
+diff -Naur language-c-0.4.2/src/Language/C/Data/Ident.hs language-c-0.4.2-new/src/Language/C/Data/Ident.hs
+--- language-c-0.4.2/src/Language/C/Data/Ident.hs 2011-08-24 09:51:19.000000000 -0500
++++ language-c-0.4.2-new/src/Language/C/Data/Ident.hs 2012-05-26 11:45:06.753087732 -0500
@@ -17,7 +17,7 @@
module Language.C.Data.Ident (
Ident(..),
@@ -42,7 +34,7 @@ diff -Naur language-c-0.4/src/Language/C/Data/Ident.hs language-c-0.4-new/src/La
- mkIdent, builtinIdent, internalIdent, internalIdentAt, isInternalIdent, identToString, dumpIdent)
+ mkIdent, builtinIdent, internalIdent, internalIdentAt, isInternalIdent, identToString, dumpIdent, hashIdent)
where
-
+
-- TODO (comment from manuel):
@@ -133,3 +133,6 @@
-- | dump the identifier string and its positions for debugging purposes
@@ -51,25 +43,14 @@ diff -Naur language-c-0.4/src/Language/C/Data/Ident.hs language-c-0.4-new/src/La
+
+hashIdent :: Ident -> Int
+hashIdent (Ident _ h _) = h
-diff -Naur language-c-0.4/src/Language/C/Data/Position.hs language-c-0.4-new/src/Language/C/Data/Position.hs
---- language-c-0.4/src/Language/C/Data/Position.hs 2011-01-06 11:46:35.000000000 -0600
-+++ language-c-0.4-new/src/Language/C/Data/Position.hs 2011-01-06 15:31:57.634482017 -0600
-@@ -50,7 +50,7 @@
- show BuiltinPosition = "<builtin>"
- show InternalPosition = "<internal>"
-
--{-# DEPRECATED posColumn "column number information is inaccurate in presence of macros - do not rely on it." #-}
-+{-- DEPRECATED posColumn "column number information is inaccurate in presence of macros - do not rely on it." --}
-
- -- | @position absoluteOffset fileName lineNumber columnNumber@ initializes a @Position@ using the given arguments
- position :: Int -> String -> Int -> Int -> Position
-diff -Naur language-c-0.4/src/Language/C/Parser/Lexer.x language-c-0.4-new/src/Language/C/Parser/Lexer.x
---- language-c-0.4/src/Language/C/Parser/Lexer.x 2011-01-06 11:46:35.000000000 -0600
-+++ language-c-0.4-new/src/Language/C/Parser/Lexer.x 2011-01-06 15:31:57.636922062 -0600
-@@ -351,6 +351,13 @@
+diff -Naur language-c-0.4.2/src/Language/C/Parser/Lexer.x language-c-0.4.2-new/src/Language/C/Parser/Lexer.x
+--- language-c-0.4.2/src/Language/C/Parser/Lexer.x 2011-08-24 09:51:19.000000000 -0500
++++ language-c-0.4.2-new/src/Language/C/Parser/Lexer.x 2012-05-26 11:46:33.213087517 -0500
+@@ -358,7 +358,14 @@
idkwtok ('v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : []) = tok 8 CTokVolatile
idkwtok ('_' : '_' : 'v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : '_' : '_' : []) = tok 12 CTokVolatile
idkwtok ('w' : 'h' : 'i' : 'l' : 'e' : []) = tok 5 CTokWhile
+-
+idkwtok ('_':'_':'b':'l':'o':'c':'k':'i':'n':'g':[]) = tok 10 CTokBlocking
+idkwtok ('_':'_':'r':'e':'m':'o':'t':'e':[]) = tok 10 CTokRemote
+idkwtok ('p':'w':'a':'i':'t':[]) = tok 5 CTokPWait
@@ -77,12 +58,13 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Lexer.x language-c-0.4-new/src/L
+idkwtok ('p':'b':'r':'e':'a':'k':[]) = tok 6 CTokPBreak
+idkwtok ('p':'p':'r':'i':'v':'a':'t':'e':[]) = tok 6 CTokPPrivate
+idkwtok ('p':'s':'h':'a':'r':'e':'d':[]) = tok 6 CTokPShared
-
++
idkwtok cs = \pos -> do
name <- getNewName
-diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/Language/C/Parser/Parser.y
---- language-c-0.4/src/Language/C/Parser/Parser.y 2011-01-11 11:33:19.331089585 -0600
-+++ language-c-0.4-new/src/Language/C/Parser/Parser.y 2011-01-11 11:44:45.593786776 -0600
+ let len = case length cs of l -> l
+diff -Naur language-c-0.4.2/src/Language/C/Parser/Parser.y language-c-0.4.2-new/src/Language/C/Parser/Parser.y
+--- language-c-0.4.2/src/Language/C/Parser/Parser.y 2011-08-24 09:51:19.000000000 -0500
++++ language-c-0.4.2-new/src/Language/C/Parser/Parser.y 2012-05-26 11:51:02.101086845 -0500
@@ -217,6 +217,8 @@
typedef { CTokTypedef _ }
typeof { CTokTypeof _ }
@@ -92,30 +74,33 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/
union { CTokUnion _ }
unsigned { CTokUnsigned _ }
void { CTokVoid _ }
-@@ -236,6 +238,11 @@
+@@ -236,7 +238,12 @@
"__builtin_va_arg" { CTokGnuC GnuCVaArg _ }
"__builtin_offsetof" { CTokGnuC GnuCOffsetof _ }
"__builtin_types_compatible_p" { CTokGnuC GnuCTyCompat _ }
+-
+pwait { CTokPWait _ }
+pbranch { CTokPBranch _ }
+pbreak { CTokPBreak _ }
+pshared { CTokPShared _ }
+pprivate { CTokPPrivate _ }
-
++
%%
-
+
+
@@ -359,6 +366,7 @@
| iteration_statement { $1 }
| jump_statement { $1 }
| asm_statement {% withNodeInfo $1 (CAsm $1) }
+ | parallel_statement { $1 }
-
-
+
+
-- parse C labeled statement (C99 6.8.1)
-@@ -473,6 +481,16 @@
- | for '(' enter_scope declaration expression_opt ';' expression_opt ')' statement leave_scope
- {% withNodeInfo $1 $ CFor (Right $4) $5 $7 $9 }
-
+@@ -374,7 +382,19 @@
+ {% withNodeInfo $1 $ CCases $2 $4 $6 }
+
+
+--- parse C compound statement (C99 6.8.2)
+-- parse Parallel C statement
+--
+parallel_statement :: { CStat }
@@ -126,10 +111,13 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/
+ {% withNodeInfo $1 $ CPBranch $2 }
+ | pbreak
+ {% withNodeInfo $1 $ CPBreak }
-
- -- parse C jump statement (C99 6.8.6)
++
++
++ -- parse C compound statement (C99 6.8.2)
--
-@@ -550,7 +568,7 @@
+ -- * GNU extension: '__label__ ident;' declarations
+ --
+@@ -550,7 +570,7 @@
-- storage class and type qualifier
---------------------------------------------------------------------------------------------------------------
attr :- __attribute__((..))
@@ -137,17 +125,17 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/
+storage_class :- typedef | extern | static | auto | register | __thread | __blocking | pprivate | ppshared
type_qualifier :- const | volatile | restrict | inline
type_qualifier_list :- type_qualifier+
-
-@@ -755,7 +773,7 @@
-
-
+
+@@ -755,7 +775,7 @@
+
+
-- A mixture of type qualifiers (const, volatile, restrict, inline) and storage class specifiers
--- (extern, static, auto, register, __thread), in any order, but containing at least one storage class specifier.
+-- (extern, static, auto, register, __thread, __blocking, pshared, pprivate), in any order, but containing at least one storage class specifier.
--
-- declaration_qualifier_list :- <permute> type_qualifier* storage_class+
--
-@@ -1188,6 +1206,10 @@
+@@ -1188,6 +1208,10 @@
| volatile {% withNodeInfo $1 $ CVolatQual }
| restrict {% withNodeInfo $1 $ CRestrQual }
| inline {% withNodeInfo $1 $ CInlineQual }
@@ -155,12 +143,12 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/
+ | "__remote" {% withNodeInfo $1 $ CRemote }
+ | pshared {% withNodeInfo $1 $ CPShared }
+ | pprivate {% withNodeInfo $1 $ CPPrivate }
-
+
-- a list containing at least one type_qualifier (const, volatile, restrict, inline)
-- and additionally CAttrs
-@@ -2161,13 +2183,17 @@
+@@ -2161,13 +2185,17 @@
withAsmNameAttrs (mAsmName, newAttrs) declr = setAsmName mAsmName (appendObjAttrsR newAttrs declr)
-
+
appendDeclrAttrs :: [CAttr] -> CDeclrR -> CDeclrR
-appendDeclrAttrs newAttrs (CDeclrR ident (Reversed []) asmname cattrs at)
- = CDeclrR ident empty asmname (cattrs ++ newAttrs) at
@@ -179,26 +167,28 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Parser.y language-c-0.4-new/src/
+ hasFunDeclr ds = any isFunDeclr ds
+appendDeclrAttrs newAttrs (CDeclrR ident derived asmname cattrs at)
+ = CDeclrR ident derived asmname (cattrs ++ newAttrs) at
-
+
ptrDeclr :: CDeclrR -> [CTypeQual] -> NodeInfo -> CDeclrR
ptrDeclr (CDeclrR ident derivedDeclrs asmname cattrs dat) tyquals at
-diff -Naur language-c-0.4/src/Language/C/Parser/Tokens.hs language-c-0.4-new/src/Language/C/Parser/Tokens.hs
---- language-c-0.4/src/Language/C/Parser/Tokens.hs 2011-01-06 11:46:35.000000000 -0600
-+++ language-c-0.4-new/src/Language/C/Parser/Tokens.hs 2011-01-06 15:31:57.643469288 -0600
-@@ -132,6 +132,13 @@
+diff -Naur language-c-0.4.2/src/Language/C/Parser/Tokens.hs language-c-0.4.2-new/src/Language/C/Parser/Tokens.hs
+--- language-c-0.4.2/src/Language/C/Parser/Tokens.hs 2011-08-24 09:51:19.000000000 -0500
++++ language-c-0.4.2-new/src/Language/C/Parser/Tokens.hs 2012-05-26 11:52:19.589086751 -0500
+@@ -132,7 +132,14 @@
| CTokTyIdent !PosLength !Ident -- `typedef-name' identifier
| CTokGnuC !GnuCTok !PosLength -- special GNU C tokens
| CTokEof -- end of file
-+ | CTokBlocking !PosLength -- '__blocking'
-+ | CTokRemote !PosLength -- '__remote'
-+ | CTokPWait !PosLength -- `pwait'
-+ | CTokPBranch !PosLength -- `pbranch'
-+ | CTokPBreak !PosLength -- `pbreak'
+-
++ | CTokBlocking !PosLength -- '__blocking'
++ | CTokRemote !PosLength -- '__remote'
++ | CTokPWait !PosLength -- `pwait'
++ | CTokPBranch !PosLength -- `pbranch'
++ | CTokPBreak !PosLength -- `pbreak'
+ | CTokPShared !PosLength -- `pshared'
+ | CTokPPrivate !PosLength -- `pprivate'
-
++
-- special tokens used in GNU C extensions to ANSI C
--
+ data GnuCTok = GnuCAttrTok -- `__attribute__'
@@ -242,6 +249,13 @@
posLenOfTok (CTokIdent pos _) = pos
posLenOfTok (CTokTyIdent pos _) = pos
@@ -211,7 +201,7 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Tokens.hs language-c-0.4-new/src
+posLenOfTok (CTokPPrivate pos ) = pos
+posLenOfTok (CTokPShared pos ) = pos
posLenOfTok CTokEof = error "tokenPos: Eof"
-
+
instance Show CToken where
@@ -327,11 +341,18 @@
showsPrec _ (CTokTypedef _ ) = showString "typedef"
@@ -232,9 +222,9 @@ diff -Naur language-c-0.4/src/Language/C/Parser/Tokens.hs language-c-0.4-new/src
showsPrec _ (CTokCLit _ c) = shows c
showsPrec _ (CTokILit _ i) = shows i
showsPrec _ (CTokFLit _ f) = shows f
-diff -Naur language-c-0.4/src/Language/C/Pretty.hs language-c-0.4-new/src/Language/C/Pretty.hs
---- language-c-0.4/src/Language/C/Pretty.hs 2011-01-06 11:46:35.000000000 -0600
-+++ language-c-0.4-new/src/Language/C/Pretty.hs 2011-01-06 15:31:57.646019992 -0600
+diff -Naur language-c-0.4.2/src/Language/C/Pretty.hs language-c-0.4.2-new/src/Language/C/Pretty.hs
+--- language-c-0.4.2/src/Language/C/Pretty.hs 2011-08-24 09:51:19.000000000 -0500
++++ language-c-0.4.2-new/src/Language/C/Pretty.hs 2012-05-26 11:53:45.233086438 -0500
@@ -154,7 +154,11 @@
pretty (CReturn Nothing _) = ii $ text "return" <> semi
pretty (CReturn (Just e) _) = ii $ text "return" <+> pretty e <> semi
@@ -248,17 +238,19 @@ diff -Naur language-c-0.4/src/Language/C/Pretty.hs language-c-0.4-new/src/Langua
let inner = text "{" $+$ mlistP ppLblDecls localLabels $+$ vcat (map pretty bis) $$ text "}"
in if p == -1 then inner else ii inner
where ppLblDecls = vcat . map (\l -> text "__label__" <+> identP l <+> semi)
-@@ -253,6 +257,10 @@
+@@ -253,7 +257,11 @@
pretty (CRestrQual _) = text "__restrict"
pretty (CInlineQual _) = text "inline"
pretty (CAttrQual a) = attrlistP [a]
+-
+ pretty (CBlocking _) = text "__blocking"
+ pretty (CRemote _) = text "__remote"
+ pretty (CPShared _) = text "pshared"
+ pretty (CPPrivate _) = text "pprivate"
-
++
instance Pretty CStructUnion where
pretty (CStruct tag ident Nothing cattrs _) = pretty tag <+> attrlistP cattrs <+> maybeP identP ident
+ pretty (CStruct tag ident (Just []) cattrs _) =
@@ -375,8 +383,8 @@
<+> maybeP pretty expr2 <+> text ":" <+> prettyPrec 4 expr3
prettyPrec p (CBinary op expr1 expr2 _) =
@@ -270,20 +262,20 @@ diff -Naur language-c-0.4/src/Language/C/Pretty.hs language-c-0.4-new/src/Langua
prettyPrec p (CCast decl expr _) =
parenPrec p 25 $ text "(" <> pretty decl <> text ")"
<+> prettyPrec 25 expr
-diff -Naur language-c-0.4/src/Language/C/Syntax/AST.hs language-c-0.4-new/src/Language/C/Syntax/AST.hs
---- language-c-0.4/src/Language/C/Syntax/AST.hs 2011-01-06 11:46:35.000000000 -0600
-+++ language-c-0.4-new/src/Language/C/Syntax/AST.hs 2011-01-06 15:31:57.648960933 -0600
-@@ -276,6 +276,9 @@
+diff -Naur language-c-0.4.2/src/Language/C/Syntax/AST.hs language-c-0.4.2-new/src/Language/C/Syntax/AST.hs
+--- language-c-0.4.2/src/Language/C/Syntax/AST.hs 2011-08-24 09:51:19.000000000 -0500
++++ language-c-0.4.2-new/src/Language/C/Syntax/AST.hs 2012-05-26 11:55:23.797086194 -0500
+@@ -295,6 +295,9 @@
| CReturn (Maybe (CExpression a)) a
-- | assembly statement
- | CAsm CAsmStmt a
-+ | CPWait CStat a
-+ | CPBranch CStat a
+ | CAsm (CAssemblyStatement a) a
++ | CPWait (CStatement a) a
++ | CPBranch (CStatement a) a
+ | CPBreak a
- deriving (Data,Typeable {-! CNode !-})
-
- -- | GNU Assembler statement
-@@ -399,6 +402,10 @@
+ deriving (Show, Data,Typeable {-! , CNode , Annotated !-})
+
+ -- Derived instance relies on fmap2 :(
+@@ -453,6 +456,10 @@
| CRestrQual a
| CInlineQual a
| CAttrQual (CAttribute a)
@@ -291,27 +283,27 @@ diff -Naur language-c-0.4/src/Language/C/Syntax/AST.hs language-c-0.4-new/src/La
+ | CRemote a -- ^ remote function
+ | CPShared a -- ^ shared variable across pbranch blocks
+ | CPPrivate a -- ^ private variable across pbranch blocks
- deriving (Data,Typeable {-! CNode !-})
-
- -- | C structure or union specifiers (K&R A8.3, C99 6.7.2.1)
-@@ -663,6 +670,9 @@
- nodeInfo (CBreak d) = nodeInfo d
- nodeInfo (CReturn _ t) = nodeInfo t
- nodeInfo (CAsm _ t) = nodeInfo t
-+ nodeInfo (CPWait _ t) = nodeInfo t
-+ nodeInfo (CPBranch _ t) = nodeInfo t
-+ nodeInfo (CPBreak t) = nodeInfo t
- instance CNode t1 => Pos (CStatement t1)
- where posOf x = posOfNode (nodeInfo x)
-
-@@ -726,6 +736,10 @@
- nodeInfo (CRestrQual d) = nodeInfo d
- nodeInfo (CInlineQual d) = nodeInfo d
- nodeInfo (CAttrQual d) = nodeInfo d
-+ nodeInfo (CBlocking d) = nodeInfo d
-+ nodeInfo (CRemote d) = nodeInfo d
-+ nodeInfo (CPPrivate d) = nodeInfo d
-+ nodeInfo (CPShared d) = nodeInfo d
- instance CNode t1 => Pos (CTypeQualifier t1)
- where posOf x = posOfNode (nodeInfo x)
-
+ deriving (Show, Data,Typeable {-! ,CNode ,Functor ,Annotated !-})
+
+
+@@ -857,6 +864,9 @@
+ nodeInfo (CBreak d) = nodeInfo d
+ nodeInfo (CReturn _ n) = nodeInfo n
+ nodeInfo (CAsm _ n) = nodeInfo n
++ nodeInfo (CPWait _ t) = nodeInfo t
++ nodeInfo (CPBranch _ t) = nodeInfo t
++ nodeInfo (CPBreak t) = nodeInfo t
+
+ instance (CNode t1) => Pos (CStatement t1) where
+ posOf x = posOf (nodeInfo x)
+@@ -1102,6 +1112,10 @@
+ nodeInfo (CRestrQual d) = nodeInfo d
+ nodeInfo (CInlineQual d) = nodeInfo d
+ nodeInfo (CAttrQual d) = nodeInfo d
++ nodeInfo (CBlocking d) = nodeInfo d
++ nodeInfo (CRemote d) = nodeInfo d
++ nodeInfo (CPPrivate d) = nodeInfo d
++ nodeInfo (CPShared d) = nodeInfo d
+
+ instance (CNode t1) => Pos (CTypeQualifier t1) where
+ posOf x = posOf (nodeInfo x)
diff --git a/maint/hs/language-c-0.4.tar.gz b/maint/hs/language-c-0.4.tar.gz
deleted file mode 100644
index 505521f..0000000
Binary files a/maint/hs/language-c-0.4.tar.gz and /dev/null differ
diff --git a/maint/hs/setup-aesop b/maint/hs/setup-aesop
new file mode 100755
index 0000000..802be69
--- /dev/null
+++ b/maint/hs/setup-aesop
@@ -0,0 +1,53 @@
+#!/bin/bash
+
+# SETUP-AESOP
+# Downloads language-c
+# Patches it with Aesop modifications, making package language-aesop
+# Installs it with cabal
+
+# broken for ./setup-aesop
+#MAINT_HS=$(echo $0|sed -e "s|^\(.*\)/[^/]*$|\1|")
+
+pushd $(dirname $0)
+MAINT_HS=$PWD
+popd
+
+echo ${MAINT_HS}
+
+VERSION=0.4.2
+
+pushd ${MAINT_HS}
+wget -c --connect-timeout=2 --read-timeout=2 --tries=1 http://hackage.haskell.org/packages/archive/language-c/${VERSION}/language-…
+popd
+
+# Put happy and alex in the path
+PATH=$HOME/.cabal/bin:$PATH
+
+tar xfz ${MAINT_HS}/language-c-${VERSION}.tar.gz >/dev/null
+if [[ $? != 0 ]]
+then
+ echo "Untar of language-c-${VERSION}.tar.gz failed!"
+ exit 1
+fi
+
+echo "Patching language-c-${VERSION} with Aesop extensions..."
+
+cd language-c-${VERSION}
+patch -p 1 < ${MAINT_HS}/language-c-${VERSION}.patch > /dev/null
+if [[ $? != 0 ]]
+then
+ echo "Patch of language-c failed!"
+ exit 1
+fi
+
+echo "Building language-aesop-${VERSION} package..."
+cabal configure
+cabal build
+echo "Installing language-aesop-${VERSION} package..."
+cabal install
+
+# rm -r language-c-${VERSION}
+
+# Local Variables:
+# sh-basic-offset: 4
+# End:
diff --git a/maint/hs/setup-cabal-local b/maint/hs/setup-cabal-local
new file mode 100755
index 0000000..62d98cf
--- /dev/null
+++ b/maint/hs/setup-cabal-local
@@ -0,0 +1,11 @@
+#!/bin/sh
+
+# SETUP-CABAL-LOCAL
+# Installs cabal locally
+# Use apt-get install cabal-install to install globally
+
+wget -c http://www.haskell.org/cabal/release/cabal-install-0.14.0/cabal-install-0.1…
+tar xvfz cabal-install-0.14.0.tar.gz
+cd cabal-install-0.14.0
+sh ./bootstrap.sh
+
diff --git a/maint/hs/setup-hs-local b/maint/hs/setup-hs-local
index fda92be..953b1e3 100755
--- a/maint/hs/setup-hs-local
+++ b/maint/hs/setup-hs-local
@@ -1,71 +1,10 @@
-#!/bin/sh
+# SETUP-HS-LOCAL
+# Uses cabal to install Haskell packages required for Aesop
-OLDPWD=$PWD
+cabal update
+cabal install alex
+cabal install happy
-cmdpath=$(echo $0|sed -e "s|^\(.*\)/[^/]*$|\1|")
-
-verbose=
-
-while [ x"$1" != x ]; do
- case $1 in
- -v) verbose=1
- shift
- continue;;
- *) arg=shift
- echo "unknown argument $arg"
- exit 1
- esac
-done
-
-install_pkg()
-{
- pname=$1
- version=$2
- cd ${OLDPWD}
- wget http://hackage.haskell.org/packages/archive/$pname/$version/$pname-$version… 2>&1 >/dev/null
- if [ $? != 0 ]; then
- echo "Get of $pname-$version from hackage.haskell.org failed!" >&2
- exit 1
- fi
- tar xvfz $pname-$version.tar.gz 2>&1 >/dev/null
- if [ $? != 0 ]; then
- echo "Untar of $pname-$version.tar.gz failed!" >&2
- exit 1
- fi
- cd $pname-$version
- runhaskell Setup configure --prefix=${OLDPWD}/GHC --user 2>&1 >/dev/null
- if [ $? != 0 ]; then
- echo "configure of $pname-$version failed!" >&2
- exit 1
- fi
- runhaskell Setup build 2>&1 >/dev/null
- if [ $? != 0 ]; then
- echo "build of $pname-$version failed!" >&2
- exit 1
- fi
- runhaskell Setup install --user 2>&1 >/dev/null
- if [ $? != 0 ]; then
- echo "install of $pname-$version failed!" >&2
- exit 1
- fi
-}
-
-vpkg()
-{
- if [ "x$verbose" != "x" ]; then
- install_pkg $1 $2
- else
- echo -n "Installing package $1, version $2..."
- install_pkg $1 $2 > /dev/null
- echo "done."
- fi
-}
-
-vpkg transformers 0.2.2.0
-vpkg mtl 2.0.1.0
-vpkg happy 1.18.6
-vpkg alex 2.3.5
-vpkg regex-base 0.93.2
-vpkg regex-posix 0.94.4
-vpkg regex-pcre-builtin 0.94.2.1.7.7
-vpkg syb 0.3
+cabal install regex-posix
+cabal install regex-pcre
+cabal install mtl
diff --git a/maint/hs/setup-langc b/maint/hs/setup-langc
deleted file mode 100755
index d30a539..0000000
--- a/maint/hs/setup-langc
+++ /dev/null
@@ -1,51 +0,0 @@
-#!/bin/sh
-
-#wget --connect-timeout=2 --read-timeout=2 --tries=1 http://hackage.haskell.org/packages/archive/language-c/0.3.1/language-c-0.3…
-
-VERSION=0.4
-
-OLDPWD=$PWD
-
-cmdpath=$(echo $0|sed -e "s|^\(.*\)/[^/]*$|\1|")
-
-# put happy and alex in the path
-PATH=${OLDPWD}/GHC/bin:$PATH
-
-echo "Patching language-c-${VERSION} with Aesop extensions..."
-
-# use local copy for now
-tar xvfz ${cmdpath}/language-c-${VERSION}.tar.gz >/dev/null 2>&1
-if [ $? != 0 ]; then
- echo "Untar of language-c-${VERSION}.tar.gz failed!"
- exit 1
-fi
-
-cd language-c-${VERSION}
-patch -p 1 < ${OLDPWD}/${cmdpath}/language-c.patch >/dev/null 2>&1
-if [ $? != 0 ]; then
- echo "Patch of language-c failed!"
- exit 1
-fi
-
-echo "Building/Installing language-aesop-${VERSION} package..."
-runhaskell Setup configure --prefix=${OLDPWD}/GHC --user >/dev/null 2>&1
-if [ $? != 0 ]; then
- echo "Configure of language-aesop failed!"
- exit 1
-fi
-
-runhaskell Setup build >/dev/null 2>&1
-if [ $? != 0 ]; then
- echo "Build of language-aesop failed!"
- exit 1
-fi
-
-runhaskell Setup install --user >/dev/null 2>&1
-if [ $? != 0 ]; then
- echo "Install of language-aesop failed!"
- exit 1
-fi
-
-
-cd -
-rm -r language-c-${VERSION}
diff --git a/parser/CGen.lhs b/parser/CGen.lhs
index b8fa422..7099242 100644
--- a/parser/CGen.lhs
+++ b/parser/CGen.lhs
@@ -310,7 +310,7 @@ int ** ret;
> mkRetDeclFromFunDef :: CFunDef -> String -> [CDecl]
> mkRetDeclFromFunDef f name =
> mkRetDecl rtype name (nodeInfo f)
-> where rtype = getFunDefReturn f
+> where rtype = fromJust $ getFunDefReturnMaybe f
Functions for building struct members from scratch
diff --git a/parser/CParse.lhs b/parser/CParse.lhs
index 6bf6d3f..5e15084 100644
--- a/parser/CParse.lhs
+++ b/parser/CParse.lhs
@@ -252,7 +252,7 @@ split a function declaration into tuple: (function-name, (return-type, return-de
> where (dn:dns) = getCDeclNames decl
> getFunInfo :: CFunDef -> (Ident, (CTypeSpec, [CDerivedDeclr]), [CDecl])
-> getFunInfo f = (getFunDefIdent f, getFunDefReturn f, getFunDefParams f)
+> getFunInfo f = (getFunDefIdent f, fromJust (getFunDefReturnMaybe f), getFunDefParams f)
Get the name of a function definition
@@ -271,11 +271,27 @@ Get the parameter declarations of a function definition
Get the return type and derived declarators for a function definition
-> getFunDefReturn :: CFunDef -> (CTypeSpec, [CDerivedDeclr])
-> getFunDefReturn (CFunDef specs (CDeclr _ derivedDeclrs _ _ _) _ _ _) =
+> getFunDefReturnMaybe :: CFunDef -> Maybe (CTypeSpec, [CDerivedDeclr])
+
+-- > getFunDefReturnMaybe (CFunDef specs (CDeclr _ derivedDeclrs _ _ _) _ _ _)
+-- > | trace ("GFDRM: " ++ show (find isTypeSpec specs)) False = undefined
+
+> getFunDefReturnMaybe (CFunDef specs (CDeclr _ derivedDeclrs _ _ _) _ _ _)
+> | isJust (find isTypeSpec specs) =
> let (CTypeSpec tspec) = fromJust $ find isTypeSpec specs
> derivedPtrs = filter isDerivedPtr derivedDeclrs
-> in (tspec, derivedPtrs)
+> in Just (tspec, derivedPtrs)
+> | otherwise = Nothing
+
+-- > getFunDefReturn :: CFunDef -> (CTypeSpec, [CDerivedDeclr])
+
+-- > getFunDefReturn (CFunDef specs (CDeclr _ derivedDeclrs _ _ _) _ _ _)
+-- > | trace ("GFDR: " ++ show (find isTypeSpec specs)) False = undefined
+
+-- > getFunDefReturn (CFunDef specs (CDeclr _ derivedDeclrs _ _ _) _ _ _) =
+-- > let (CTypeSpec tspec) = fromJust $ find isTypeSpec specs
+-- > derivedPtrs = filter isDerivedPtr derivedDeclrs
+-- > in (tspec, derivedPtrs)
> isBlockingSpec :: CDeclSpec -> Bool
> isBlockingSpec (CTypeQual (CBlocking _)) = True
diff --git a/parser/Walker.lhs b/parser/Walker.lhs
index ab2923f..2cd4ad1 100644
--- a/parser/Walker.lhs
+++ b/parser/Walker.lhs
@@ -227,7 +227,7 @@ Turns into:
> w <- get
> put $ w { fpTypeReg = fptype : (fpTypeReg w) }
-Registery a blocking function pointer.
+Register a blocking function pointer.
> registerBlocking :: FunDecl -> WalkerT ()
> registerBlocking fd = do
diff --git a/parser/ae-blocking-parser.lhs b/parser/ae-blocking-parser.lhs
index bacb30f..054fb9e 100644
--- a/parser/ae-blocking-parser.lhs
+++ b/parser/ae-blocking-parser.lhs
@@ -30,6 +30,18 @@
> import Header
> import System.Directory
+Toggle abp_trace:
+
+> abp_trace_enabled = True
+
+-- > abp_trace_enabled = False
+
+Aesop Blocking Parser trace:
+
+> abp_trace :: String -> IO ()
+> abp_trace s =
+> if abp_trace_enabled then putStrLn s else putStr ""
+
> aesopCtlPrefix :: String
> aesopCtlPrefix = "__ae_ctl"
@@ -62,8 +74,8 @@
> mkBlockingParamsForStruct :: CFunDef -> WalkerT [CDecl]
> mkBlockingParamsForStruct fdef = do
-> let ni = nodeInfo fdef
-> ret = getFunDefReturn fdef
+> let ni = nodeInfo fdef
+> ret = fromJust $ getFunDefReturnMaybe fdef
> ds <- mkDeclsFromBlocking "AE_MK_BFUN_PARAMS_FOR_STRUCT_DECLS" [] ni
> return $ ds
> ++ (mkRetParam ret ni) -- optional return parameter: [__ret_type __ae_ret]
@@ -71,12 +83,12 @@
> mkBlockingParamsForFunction :: (CTypeSpec, [CDerivedDeclr]) -> NodeInfo -> WalkerT [CDecl]
> mkBlockingParamsForFunction retType ni = do
-> ds <- mkDeclsFromBlocking "AE_MK_BFUN_PARAMS_DECLS" [] ni
+> ds <- mkDeclsFromBlocking "AE_MK_BFUN_PARAMS_DECLS" [] ni
> -- callback parameter: void (*callback) (void *user_ptr, [, __ret_type __ae_ret])
> let cbParam = mkCBParam retType ni
> retParam = mkRetParam retType ni
> return $ cbParam ++ ds ++ retParam
-
+
> mkWorkerParams :: String -> NodeInfo -> WalkerT [CDecl]
> mkWorkerParams n ni = do
> ds <- mkDeclsFromBlocking "AE_MK_WORKER_PARAMS" [n] ni
@@ -84,12 +96,12 @@
> mkBlockingParamsFromFunPtrDecl :: CDecl -> WalkerT [CDecl]
> mkBlockingParamsFromFunPtrDecl c@(CDecl _ declrs ni) = do
-> let retType = getReturn c
-> ds <- mkDeclsFromBlocking "AE_MK_BFUN_PARAMS_FUN_PTR_DECLS" [returnToString retType] ni
+> let retType = getReturn c
+> ds <- mkDeclsFromBlocking "AE_MK_BFUN_PARAMS_FUN_PTR_DECLS" [returnToString retType] ni
> return $ (mkCBParam retType ni) ++ ds
> mkBlockingRetType :: NodeInfo -> WalkerT CTypeSpec
-> mkBlockingRetType ni = do
+> mkBlockingRetType ni = do
> prd <- mkBlockingRetDecl ni
> return $ fst $ getReturn prd
@@ -97,7 +109,7 @@
> mkBlockingRetDecl ni = liftM head $ mkDeclsFromBlocking "AE_MK_BFUN_RET_DECL" [] ni
> getLastStmtInCompounds :: CStat -> Maybe CStat
-> getLastStmtInCompounds (CCompound _ bitems _)
+> getLastStmtInCompounds (CCompound _ bitems _)
> | null bitems = Nothing
> | isJust s = getLastStmtInCompounds $ fromJust s
> | otherwise = s
@@ -107,13 +119,13 @@
> checkForReturn :: CFunDef -> WalkerT CFunDef
> checkForReturn f@(CFunDef specs declarator decls c@(CCompound idents stmts cni) ni)
-> | isVoidReturn $ getFunDefReturn f =
+> | isVoidReturn $ fromJust $ getFunDefReturnMaybe f =
> if null stmts then addVoidReturn
> else if isNothing $ getBlockStmt $ last stmts then addVoidReturn
> else if not $ isReturnStmt $ fromJust $ getBlockStmt $ last stmts then addVoidReturn
> else return f
-> | otherwise = do
+> | otherwise = do
> when (null stmts) $ errorNonVoidReturn
> when (isNothing $ getLastStmtInCompounds c) $ errorNonVoidReturn
> when (not $ isReturnStmt $ fromJust $ getLastStmtInCompounds c) $ errorNonVoidReturn
@@ -132,7 +144,7 @@
> mkAnonStructName :: NodeInfo -> Ident
> mkAnonStructName ni = newIdent n ni
> where n = "anonstruct_" ++ (show $ posRow $ posOfNode $ ni) ++ "_" ++
-> (show $ posColumn $ posOfNode $ ni)
+> (show $ posColumn $ posOfNode $ ni)
> lookupAndRegBlocking :: Maybe Ident -> CDecl -> WalkerT ()
> lookupAndRegBlocking sname d@(CDecl s i n) = do
@@ -140,8 +152,8 @@
> t = if isJust typeName then fromJust typeName else mkAnonStructName $ nodeInfo d
> assert (isJust sname) return ()
> lookupAndRegisterBlockingStruct (fromJust sname)
-> (getCDeclName d)
-> t
+> (getCDeclName d)
+> t
> regBlockingStruct :: Maybe Ident -> CDecl -> WalkerT ()
> regBlockingStruct sname d = do
@@ -166,11 +178,11 @@
> registerTypedefStruct :: CDecl -> Maybe Ident -> WalkerT ()
> registerTypedefStruct d altSname = do
-> let t = getStructTypeDefInfo d
-> (Just (sn, tname)) = t
-> sname = if isJust sn then sn else altSname
-> assert (isJust t && isJust sname) return ()
-> lookupAndRegisterBlockingTypedef (fromJust sname) tname
+> let t = getStructTypeDefInfo d
+> (Just (sn, tname)) = t
+> sname = if isJust sn then sn else altSname
+> assert (isJust t && isJust sname) return ()
+> lookupAndRegisterBlockingTypedef (fromJust sname) tname
> registerTypedefTypedef :: CDecl -> WalkerT ()
> registerTypedefTypedef d = do
@@ -183,18 +195,18 @@
> registerBlockingDecl ph e@(CDeclExt d@(CDecl specifiers initdecls ni))
> | isTypeDefOfInlineStruct d = do
-> let name = mkAnonStructName (nodeInfo d)
-> registerStruct d (Just name)
-> registerTypedefStruct d (Just name)
-> if ph then
-> return [e]
-> else return []
+> let name = mkAnonStructName (nodeInfo d)
+> registerStruct d (Just name)
+> registerTypedefStruct d (Just name)
+> if ph then
+> return [e]
+> else return []
> | isTypeDefOfPredefStruct d = do
-> registerTypedefStruct d Nothing
-> if ph then
-> return [e]
-> else return []
+> registerTypedefStruct d Nothing
+> if ph then
+> return [e]
+> else return []
> | isTypeDefOfTypeDef d = do
> registerTypedefTypedef d
@@ -208,43 +220,43 @@ etc. etc.
> | isStructDecl d = do
> addGlobals [d]
-> registerStruct d Nothing
-> if ph then
-> liftM ((:[]) . CDeclExt) $ everywhereM (mkM translateBlockingFunParam) d
-> else return []
+> registerStruct d Nothing
+> if ph then
+> liftM ((:[]) . CDeclExt) $ everywhereM (mkM translateBlockingFunParam) d
+> else return []
Register global variable declarations. This is necessary to map variable names to types (structs, typedefs, etc.)
allowing us to determine if a function pointer is being called within a particular variable.
> | isVarDecl d = do
-> addGlobals [d]
-> let name = mkAnonStructName $ nodeInfo d
-> when (isStructDecl d) (registerStruct (removeVarFromDecl d) (Just name))
-> if ph then return [e] else return []
+> addGlobals [d]
+> let name = mkAnonStructName $ nodeInfo d
+> when (isStructDecl d) (registerStruct (removeVarFromDecl d) (Just name))
+> if ph then return [e] else return []
Register blocking function declarations: __blocking int myfun();
-> | isFunDecl d && (any isBlockingSpec specifiers) = do
-> let function = splitFunDecl (CDecl specifiers initdecls ni)
+> | isFunDecl d && (any isBlockingSpec specifiers) = do
+> let function = splitFunDecl (CDecl specifiers initdecls ni)
> registerBlocking function
> pDecl <- mkBlockingDecl function specifiers
> -- pPtrDecl <- mkBlockingPtrDecl True function specifiers
-> return $ [CDeclExt pDecl]
+> return $ [CDeclExt pDecl]
Transform function declarations that take blocking function pointers as parameters: int myfun(__blocking int (*fnp)(void));
We only need to do the transformation here to get the type signature right, we don't generate anything else.
> | isFunDecl d = do
-> if ph then
-> liftM ((:[]) . CDeclExt) $ everywhereM (mkM translateBlockingFunParam) d
-> else return []
+> if ph then
+> liftM ((:[]) . CDeclExt) $ everywhereM (mkM translateBlockingFunParam) d
+> else return []
let (fname, (rtype, derived), ps) = splitFunDecl d
newps <- mapM translateBlockingFunParam ps
let newd = mkFunDeclWithDeclSpecs fname rtype derived specifiers newps
if ph then return [CDeclExt newd]
else return []
-
+
> registerBlockingDecl True c = do
> return [c]
> registerBlockingDecl False c = do
@@ -254,13 +266,13 @@ Registers all the blocking declarations present in the CTranslUnit
> registerBlockingFunDecls :: CTranslUnit -> WalkerT CTranslUnit
> registerBlockingFunDecls (CTranslUnit decls ni) = do
-> newdecls <- liftM concat $ sequence $ map (registerBlockingDecl True) decls
-> return $ CTranslUnit newdecls ni
+> newdecls <- liftM concat $ sequence $ map (registerBlockingDecl True) decls
+> return $ CTranslUnit newdecls ni
> getBlockingHeaderDecls :: CTranslUnit -> WalkerT [([CExtDecl], CExtDecl)]
> getBlockingHeaderDecls (CTranslUnit decls ni) = do
-> newdecls <- sequence $ map (registerBlockingDecl False) decls
-> return $ zip newdecls decls
+> newdecls <- sequence $ map (registerBlockingDecl False) decls
+> return $ zip newdecls decls
Registers blocking function pointers passed to a blocking function.
@@ -275,15 +287,15 @@ gets called in the blocking function myblockingfun.
> registerBlockingFunParam :: CDecl -> WalkerT ()
> registerBlockingFunParam (CDecl specifiers initdecls ni)
-> | (any isBlockingSpec specifiers) = do
-> let retType = getTypeSpec specifiers
-> (Just declr, _, _) = head initdecls
-> (CDeclr (Just f) derivedDeclrs _ _ _) = declr
-> (Just funDeclr) = find isFunDeclr derivedDeclrs
+> | (any isBlockingSpec specifiers) = do
+> let retType = getTypeSpec specifiers
+> (Just declr, _, _) = head initdecls
+> (CDeclr (Just f) derivedDeclrs _ _ _) = declr
+> (Just funDeclr) = find isFunDeclr derivedDeclrs
> deriveds = filter (not . (\d -> isFunDeclr d || isDerivedPtr d)) derivedDeclrs
-> params = removeVoid $ getCFunDeclrParams funDeclr
-> registerLocalBlocking (f, (retType, deriveds), params)
-> | otherwise = return ()
+> params = removeVoid $ getCFunDeclrParams funDeclr
+> registerLocalBlocking (f, (retType, deriveds), params)
+> | otherwise = return ()
> declHasBlockingFunPtrParam :: CDecl -> Bool
> declHasBlockingFunPtrParam d =
@@ -304,13 +316,13 @@ gets called in the blocking function myblockingfun.
> | isBlockingFunDecl fptr = do
> bParams <- mkBlockingParamsFromFunPtrDecl fptr
> ret <- mkBlockingRetType ni
-> let specs = filter (not . isBlockingSpec) specifiers
-> (Just declr, _, _) = head initdecls
-> (CDeclr (Just (Ident fname _ _)) _ _ _ _) = declr
-> funDeclr = getDerivedFun declr
-> params = removeVoid $ getCFunDeclrParams funDeclr
-> postParams = bParams ++ params
-> return $ mkFunPtrDecl fname ret postParams
+> let specs = filter (not . isBlockingSpec) specifiers
+> (Just declr, _, _) = head initdecls
+> (CDeclr (Just (Ident fname _ _)) _ _ _ _) = declr
+> funDeclr = getDerivedFun declr
+> params = removeVoid $ getCFunDeclrParams funDeclr
+> postParams = bParams ++ params
+> return $ mkFunPtrDecl fname ret postParams
> | otherwise = return fptr
@@ -333,13 +345,13 @@ gets called in the blocking function myblockingfun.
> invalid :: String -> NodeInfo -> WalkerT ()
> invalid msg ni = do
-> fstr <- getFilePosStr ni
-> error (fstr ++ ": Invalid aesop usage: " ++ msg)
+> fstr <- getFilePosStr ni
+> error (fstr ++ ": Invalid aesop usage: " ++ msg)
> gspWarn :: String -> NodeInfo -> WalkerT ()
> gspWarn msg ni = do
-> fstr <- getFilePosStr ni
-> putStrLnW $ fstr ++ ": warning: " ++ msg
+> fstr <- getFilePosStr ni
+> putStrLnW $ fstr ++ ": warning: " ++ msg
> isValidBlockingFunDef :: CFunDef -> WalkerT ()
> isValidBlockingFunDef f@(CFunDef specs (CDeclr _ derivedDeclrs _ _ _) _ _ _) = do
@@ -352,40 +364,40 @@ gets called in the blocking function myblockingfun.
> isValidBlockingFor :: CStat -> WalkerT ()
> isValidBlockingFor (CFor (Right _) _ _ _ ni) = invalid "declaration in blocking for loop" ni
> isValidBlockingFor (CFor (Left init) expr1 expr2 stmts ni) = do
-> binit <- containsBlockingCall (CExpr init ni)
-> when binit $ invalid "init expression in for loop cannot contain a blocking call" ni
-> bexpr1 <- containsBlockingCall (CExpr expr1 ni)
-> when bexpr1 $ invalid "conditional expression in for loop cannot contain a blocking call" ni
-> bexpr2 <- containsBlockingCall (CExpr expr2 ni)
-> when bexpr2 $ invalid "update expression in for loop cannot contain a blocking call" ni
-> when (not $ isCompound stmts)
-> $ invalid "blocking for loop requires curly brackets" ni
-> when (fst $ stmtsHaveDecl stmts)
-> $ invalid "blocking for loop cannot contain local declarations" (snd $ stmtsHaveDecl stmts)
-> return ()
+> binit <- containsBlockingCall (CExpr init ni)
+> when binit $ invalid "init expression in for loop cannot contain a blocking call" ni
+> bexpr1 <- containsBlockingCall (CExpr expr1 ni)
+> when bexpr1 $ invalid "conditional expression in for loop cannot contain a blocking call" ni
+> bexpr2 <- containsBlockingCall (CExpr expr2 ni)
+> when bexpr2 $ invalid "update expression in for loop cannot contain a blocking call" ni
+> when (not $ isCompound stmts)
+> $ invalid "blocking for loop requires curly brackets" ni
+> when (fst $ stmtsHaveDecl stmts)
+> $ invalid "blocking for loop cannot contain local declarations" (snd $ stmtsHaveDecl stmts)
+> return ()
> isValidBlockingWhile :: CStat -> WalkerT ()
> isValidBlockingWhile (CWhile expr stmts isDoWhile ni) = do
-> bexpr <- containsBlockingCall (CExpr (Just expr) ni)
-> when bexpr $ invalid "conditional expression in while loop cannot contain a blocking call" ni
-> when (not $ isCompound stmts)
-> $ invalid "blocking while loop requires curly brackets" ni
-> when (fst $ stmtsHaveDecl stmts)
-> $ invalid "blocking while loop cannot contain local declarations" (snd $ stmtsHaveDecl stmts)
-> return ()
+> bexpr <- containsBlockingCall (CExpr (Just expr) ni)
+> when bexpr $ invalid "conditional expression in while loop cannot contain a blocking call" ni
+> when (not $ isCompound stmts)
+> $ invalid "blocking while loop requires curly brackets" ni
+> when (fst $ stmtsHaveDecl stmts)
+> $ invalid "blocking while loop cannot contain local declarations" (snd $ stmtsHaveDecl stmts)
+> return ()
> isValidBlockingIf :: CStat -> WalkerT ()
> isValidBlockingIf (CIf expr ifStmts elseStmts ni) = do
-> bexpr <- containsBlockingCall (CExpr (Just expr) ni)
-> when bexpr $ invalid "if expression cannot contain a blocking call" ni
-> when (not $ isCompound ifStmts)
-> $ invalid "blocking if requires curly brackets" ni
-> when (fst $ stmtsHaveDecl $ ifStmts)
-> $ invalid "if block with blocking calls cannot contain local declarations" (snd $ stmtsHaveDecl $ ifStmts)
-> when ((isJust elseStmts) && (isCompound $ fromJust elseStmts) && (fst $ stmtsHaveDecl $ fromJust elseStmts))
-> $ invalid "else block with blocking calls cannot contain local declarations" (snd $ stmtsHaveDecl $ fromJust elseStmts)
-> return ()
+> bexpr <- containsBlockingCall (CExpr (Just expr) ni)
+> when bexpr $ invalid "if expression cannot contain a blocking call" ni
+> when (not $ isCompound ifStmts)
+> $ invalid "blocking if requires curly brackets" ni
+> when (fst $ stmtsHaveDecl $ ifStmts)
+> $ invalid "if block with blocking calls cannot contain local declarations" (snd $ stmtsHaveDecl $ ifStmts)
+> when ((isJust elseStmts) && (isCompound $ fromJust elseStmts) && (fst $ stmtsHaveDecl $ fromJust elseStmts))
+> $ invalid "else block with blocking calls cannot contain local declarations" (snd $ stmtsHaveDecl $ fromJust elseStmts)
+> return ()
> isValidPWait :: CStat -> WalkerT ()
> isValidPWait (CPWait stmts ni) = do
@@ -401,23 +413,23 @@ gets called in the blocking function myblockingfun.
> getBlockingCallName :: CExpr -> WalkerT (Maybe Ident)
> getBlockingCallName (CCall e args _) = do
-> res <- lookupBlocking e
-> case res of { (Just (bname, _, _)) -> return $ Just bname ; Nothing -> return Nothing }
+> res <- lookupBlocking e
+> case res of { (Just (bname, _, _)) -> return $ Just bname ; Nothing -> return Nothing }
> getBlockingCallName _ = return Nothing
> findBlockingCallName :: CStat -> WalkerT (Maybe Ident)
-> findBlockingCallName stmt =
-> everything orElseMMaybe (mkQ (return Nothing) getBlockingCallName) $ stmt
+> findBlockingCallName stmt =
+> everything orElseMMaybe (mkQ (return Nothing) getBlockingCallName) $ stmt
> getBlockingCallExpr :: CExpr -> WalkerT (Maybe CExpr)
> getBlockingCallExpr call@(CCall e _ _) = do
-> res <- lookupBlocking e
-> if isJust res then return $ Just call else return Nothing
+> res <- lookupBlocking e
+> if isJust res then return $ Just call else return Nothing
> getBlockingCallExpr _ = return Nothing
> findBlockingCallExpr :: CStat -> WalkerT (Maybe CExpr)
-> findBlockingCallExpr stmt =
-> everything orElseMMaybe (mkQ (return Nothing) getBlockingCallExpr) $ stmt
+> findBlockingCallExpr stmt =
+> everything orElseMMaybe (mkQ (return Nothing) getBlockingCallExpr) $ stmt
> getBlockingCall :: CExpr -> WalkerT (Maybe (CExpr, FunDecl))
> getBlockingCall call@(CCall e _ _) = do
@@ -434,18 +446,18 @@ function replaces the blocking call with a variable "ret", and returns that as t
> replaceCallWithExpr :: CExpr -> CExpr -> WalkerT CExpr
> replaceCallWithExpr newe call@(CCall e _ ni) = do
-> res <- lookupBlocking e
-> if isJust res then return newe else return call
+> res <- lookupBlocking e
+> if isJust res then return newe else return call
> replaceCallWithExpr _ c = return c
> findAndReplaceBlockingCall :: CExpr -> CStat -> WalkerT CStat
> -- if the statement is just the blocking call (the return value is ignored), we don't replace
> findAndReplaceBlockingCall newe (CExpr (Just call@(CCall e _ _)) ni) = do
-> res <- lookupBlocking e
-> if isJust res then return (mkCompoundStmt (Just $ "__ae_result_expr_" ++ (mkLineColStr ni)) [] ni) else do
-> expr <- replaceCallWithExpr newe call
-> return (CExpr (Just expr) ni)
+> res <- lookupBlocking e
+> if isJust res then return (mkCompoundStmt (Just $ "__ae_result_expr_" ++ (mkLineColStr ni)) [] ni) else do
+> expr <- replaceCallWithExpr newe call
+> return (CExpr (Just expr) ni)
> findAndReplaceBlockingCall newe stmt = everywhereM (mkM $ replaceCallWithExpr newe) stmt
@@ -495,18 +507,18 @@ From a blocking function definition, Construct an external declaration parameter
> mkBlockingParamsStruct :: CFunDef -> WalkerT CExtDecl
> mkBlockingParamsStruct funDef = do
-> let decls = getFunDefParams funDef
-> ni = nodeInfo funDef
+> let decls = getFunDefParams funDef
+> ni = nodeInfo funDef
> bParams <- sequence $ map translateBlockingFunParam $ removeVoid decls
-> let params = bParams ++ (map removeInitFromDecl $ getFunLocalDeclarations funDef)
-> return $ genStructExtDecl (mkStructParamsName $ getFunDefName funDef) params ni
+> let params = bParams ++ (map removeInitFromDecl $ getFunLocalDeclarations funDef)
+> return $ genStructExtDecl (mkStructParamsName $ getFunDefName funDef) params ni
> mkBlockingRetParamDecl :: CExpr -> WalkerT [CDecl]
> mkBlockingRetParamDecl e = do
-> bfun <- lookupBlocking e
+> bfun <- lookupBlocking e
> assert (isJust bfun) $ return ()
> let (Just (bname, (retSpec, retDerives), params)) = bfun
-> ni = nodeInfo e
+> ni = nodeInfo e
> case (retSpec, retDerives) of
> (CVoidType _, []) -> return []
> _ -> return $ [mkCDecl retSpec retDerives (mkCallbackRetParam (getCallName e) ni) ni]
@@ -515,32 +527,32 @@ From a blocking function definition, Construct an external declaration parameter
> mkBlockingRetParamsStruct funDef blockingCalls = do
> params <- liftM concat $ sequence $ map mkBlockingRetParamDecl blockingCalls
> return $ genStructExtDecl (mkStructRetParamsName $ getFunDefName funDef) params (nodeInfo funDef)
-
+
> removeInits :: (String, [CDecl]) -> (String, [CDecl])
> removeInits (pwaitName, pwaitDecls) = (pwaitName, (map removeInitFromDecl pwaitDecls))
> mkPWaitExtDecl :: (String -> String) -> (String, [CDecl]) -> NodeInfo -> CExtDecl
> mkPWaitExtDecl snamef (pwaitName, pwaitDecls) ni =
-> genStructExtDecl (snamef pwaitName) pwaitDecls ni
+> genStructExtDecl (snamef pwaitName) pwaitDecls ni
> mkBlockingPBranchStructs :: CFunDef -> (String, CStat) -> WalkerT [CExtDecl]
> mkBlockingPBranchStructs funDef (pwaitName, pwaitStmt) = do
-> let fname = getFunDefName funDef
-> ni = nodeInfo funDef
-> pbranches = getPBranches pwaitStmt
-> pbranchDecls = zip (map (getPBranchId funDef) pbranches) (map getPBranchDecls pbranches)
-> params = map removeInits pbranchDecls
-> return $ map (\p -> mkPBranchExtDecl fname pwaitName p ni) params
+> let fname = getFunDefName funDef
+> ni = nodeInfo funDef
+> pbranches = getPBranches pwaitStmt
+> pbranchDecls = zip (map (getPBranchId funDef) pbranches) (map getPBranchDecls pbranches)
+> params = map removeInits pbranchDecls
+> return $ map (\p -> mkPBranchExtDecl fname pwaitName p ni) params
> addPBranchParams :: CFunDef -> CStat -> (String, [CDecl]) -> (String, [CDecl])
-> addPBranchParams funDef pwait (pwaitId, pWaitDecls) =
-> let fname = getFunDefName funDef
-> ni = nodeInfo funDef
-> pbranchDecls =
+> addPBranchParams funDef pwait (pwaitId, pWaitDecls) =
+> let fname = getFunDefName funDef
+> ni = nodeInfo funDef
+> pbranchDecls =
> map (\p -> mkStructDecl
-> (mkStructPBranchName fname pwaitId (getPBranchId funDef p))
-> (mkParamPBranchName (getPBranchId funDef p)) ni) $ getPBranches pwait
-> in (pwaitId, (pWaitDecls ++ pbranchDecls))
+> (mkStructPBranchName fname pwaitId (getPBranchId funDef p))
+> (mkParamPBranchName (getPBranchId funDef p)) ni) $ getPBranches pwait
+> in (pwaitId, (pWaitDecls ++ pbranchDecls))
> containsPWait :: CFunDef -> Bool
> containsPWait funDef = everything (||) (mkQ False isPWaitStmt) funDef
@@ -561,52 +573,52 @@ From a blocking function definition, Construct an external declaration parameter
> mkBlockingPWaitStructs funDef
> | containsPWait funDef = do
> let fname = getFunDefName funDef
-> ni = nodeInfo funDef
+> ni = nodeInfo funDef
> pwaits = getPWaits funDef
> ids = map (getPWaitId funDef) pwaits
> privatePWaitDecls = zip ids (map getPWaitPrivateDecls pwaits) -- :: [(pwait_id, [private_decl])]
> sharedPWaitDecls = zip ids (map getPWaitSharedDecls pwaits) -- :: [(pwait_id, [shared_decl])]
> private = map removeInits privatePWaitDecls -- :: [(pwait_id, [private_decl_no_inits])]
> shared = map removeInits sharedPWaitDecls -- :: [(pwait_id, [shared_decl_no_inits])]
-> privateWithPBranch = zipWith (addPBranchParams funDef) pwaits private -- :: [(pwait_id, [shared_decl_no_inits] ++ [pbranch_struct_decl])]
+> privateWithPBranch = zipWith (addPBranchParams funDef) pwaits private -- :: [(pwait_id, [shared_decl_no_inits] ++ [pbranch_struct_decl])]
> privatePWaitStructs = map (\p -> mkPWaitExtDecl (mkPrivateParamPWaitName fname) p ni) privateWithPBranch
> sharedPWaitStructs = map (\p -> mkPWaitExtDecl (mkSharedParamPWaitName fname) p ni) shared
> pwaitParams = map (\id -> (id, [mkStructDecl (mkPrivateParamPWaitName fname id) mkPrivateName ni,
> mkStructDecl (mkSharedParamPWaitName fname id) mkSharedName ni,
> mkStructPtrDecl (mkSharedParamPWaitName fname id) mkSharedPtrName ni])) ids -- [(pwait_id, [private_struct, shared_struct])]
> pwaitStructs = map (\p -> mkPWaitExtDecl (mkStructPWaitName fname) p ni) pwaitParams
-> pwaitNamePairs = zip (map (getPWaitId funDef) pwaits) pwaits
-> pbranchStructs <- liftM concat $ mapM (mkBlockingPBranchStructs funDef) pwaitNamePairs
-> return $ pbranchStructs ++ privatePWaitStructs ++ sharedPWaitStructs ++ pwaitStructs
+> pwaitNamePairs = zip (map (getPWaitId funDef) pwaits) pwaits
+> pbranchStructs <- liftM concat $ mapM (mkBlockingPBranchStructs funDef) pwaitNamePairs
+> return $ pbranchStructs ++ privatePWaitStructs ++ sharedPWaitStructs ++ pwaitStructs
> | otherwise = return []
> mkPBranchExtDecl :: String -> String -> (String, [CDecl]) -> NodeInfo -> CExtDecl
> mkPBranchExtDecl fname pwaitName (pbranchName, pbranchDecls) ni =
-> genStructExtDecl (mkStructPBranchName fname pwaitName pbranchName) pbranchDecls ni
+> genStructExtDecl (mkStructPBranchName fname pwaitName pbranchName) pbranchDecls ni
> mkBlockingCtlStruct :: CFunDef -> Bool -> WalkerT CExtDecl
> mkBlockingCtlStruct funDef pblock = do
-> let ni = nodeInfo funDef
-> fname = getFunDefName funDef
-> ctlName = mkStructCtlName fname
-> spName = mkStructParamsName fname
+> let ni = nodeInfo funDef
+> fname = getFunDefName funDef
+> ctlName = mkStructCtlName fname
+> spName = mkStructParamsName fname
> retSPName = mkStructRetParamsName fname
-> fieldsDecl = mkStructDecl spName "fields" ni
-> paramsDecl = mkStructPtrDecl spName "params" ni
+> fieldsDecl = mkStructDecl spName "fields" ni
+> paramsDecl = mkStructPtrDecl spName "params" ni
> returnsDecl = mkStructDecl retSPName "return_params" ni
-> pwaitDecls = map (\p -> mkStructDecl (mkStructPWaitName fname (getPWaitId funDef p))
-> (mkPWaitName (getPWaitId funDef p)) ni)
-> $ getPWaits funDef
+> pwaitDecls = map (\p -> mkStructDecl (mkStructPWaitName fname (getPWaitId funDef p))
+> (mkPWaitName (getPWaitId funDef p)) ni)
+> $ getPWaits funDef
-> fret = getFunDefReturn funDef
+> fret = fromJust $ getFunDefReturnMaybe funDef
> retValDecl = if isVoidReturn fret then [] else [mkCDecl (fst fret) (snd fret) "return_value" ni]
->
-> bparams <- mkBlockingParamsForStruct funDef
-> pparams <- mkBlockingParamsParallelFields (getFunDefName funDef) pblock ni
+>
+> bparams <- mkBlockingParamsForStruct funDef
+> pparams <- mkBlockingParamsParallelFields (getFunDefName funDef) pblock ni
-> return $ genStructExtDecl ctlName
-> (bparams ++ pparams ++
-> [fieldsDecl, paramsDecl, returnsDecl] ++ retValDecl ++ pwaitDecls) ni
+> return $ genStructExtDecl ctlName
+> (bparams ++ pparams ++
+> [fieldsDecl, paramsDecl, returnsDecl] ++ retValDecl ++ pwaitDecls) ni
> mkBlockingFunName :: String -> String -> String
> mkBlockingFunName ctlName name = name
@@ -639,37 +651,37 @@ Each callback function defined for a given blocking function must have a unique
> addParamsPtrPrefixToExpr :: String -> String -> [Ident] -> CExpr -> CExpr
> addParamsPtrPrefixToExpr ctlPrefix paramsPrefix locals expr
-> | isVarIn locals expr = addStructPtrPrefix ctlPrefix paramsPrefix expr
+> | isVarIn locals expr = addStructPtrPrefix ctlPrefix paramsPrefix expr
> | isCallIn locals expr = addStructPtrPrefix ctlPrefix paramsPrefix expr
-> | otherwise = expr
+> | otherwise = expr
> addParamsPtrPrefixes :: String -> String -> [Ident] -> CStat -> CStat
> addParamsPtrPrefixes ctlPrefix paramsPrefix idents stmt = everywhere (mkT $ addParamsPtrPrefixToExpr ctlPrefix paramsPrefix idents) stmt
> addParamsPrefixToExpr :: String -> String -> [Ident] -> CExpr -> CExpr
> addParamsPrefixToExpr ctlPrefix paramsPrefix locals expr
-> | isVarIn locals expr = addStructPrefix ctlPrefix paramsPrefix expr
+> | isVarIn locals expr = addStructPrefix ctlPrefix paramsPrefix expr
> | isCallIn locals expr = addStructPrefix ctlPrefix paramsPrefix expr
-> | otherwise = expr
+> | otherwise = expr
> addParamsPrefixes :: String -> String -> [Ident] -> CStat -> CStat
> addParamsPrefixes ctlPrefix paramsPrefix idents stmt = everywhere (mkT $ addParamsPrefixToExpr ctlPrefix paramsPrefix idents) stmt
> addParams2PrefixToExpr :: String -> String -> String -> [Ident] -> CExpr -> CExpr
> addParams2PrefixToExpr ctlPrefix p1Prefix p2Prefix locals expr
-> | isVarIn locals expr = addStructPrefixPrefix ctlPrefix p1Prefix p2Prefix expr
+> | isVarIn locals expr = addStructPrefixPrefix ctlPrefix p1Prefix p2Prefix expr
> | isCallIn locals expr = addStructPrefixPrefix ctlPrefix p1Prefix p2Prefix expr
-> | otherwise = expr
+> | otherwise = expr
> addParams2Prefixes :: String -> String -> String -> [Ident] -> CStat -> CStat
> addParams2Prefixes ctlPrefix p1Prefix p2Prefix idents stmt =
-> everywhere (mkT $ addParams2PrefixToExpr ctlPrefix p1Prefix p2Prefix idents) stmt
+> everywhere (mkT $ addParams2PrefixToExpr ctlPrefix p1Prefix p2Prefix idents) stmt
> addParams2PtrPrefixToExpr :: String -> String -> String -> [Ident] -> CExpr -> CExpr
> addParams2PtrPrefixToExpr ctlPrefix p1Prefix p2Prefix locals expr
-> | isVarIn locals expr = addStructPtrPrefixPrefix ctlPrefix p1Prefix p2Prefix expr
+> | isVarIn locals expr = addStructPtrPrefixPrefix ctlPrefix p1Prefix p2Prefix expr
> | isCallIn locals expr = addStructPtrPrefixPrefix ctlPrefix p1Prefix p2Prefix expr
-> | otherwise = expr
+> | otherwise = expr
addParams2PtrPrefixes "foo" "bar" "baz" [locals] localvar
@@ -693,20 +705,20 @@ runfun(ctl->fields.a, ctl->fields.b, ctl->fields.c, ctl->fields.d);
> trPBranchLocals :: BlockingContext -> CStat -> CStat
> trPBranchLocals bctx stmt
> | isPBranchContext bctx =
-> let locals = join $ map getCDeclNames $ getPBranchDecls (pbranchStmt bctx)
+> let locals = join $ map getCDeclNames $ getPBranchDecls (pbranchStmt bctx)
> pwaitCtx = parent bctx
> fdef = funDef $ getParent bctx
> pwaitName = mkPWaitName $ "pwait_" ++ (mkLineColStr $ nodeInfo $ pwaitStmt pwaitCtx)
> pbranchName = mkParamPBranchName $ getPBranchId fdef $ pbranchStmt bctx
> in if parentIsPWait bctx then
->
+>
> -- pbranch has a parameter struct in the pwait struct for the control struct
> -- myvar becomes: ctl->pwait_100_23.pbranch_123_10.myvar
-> addParams2Prefixes aesopCtlPrefix
-> (pwaitName ++ "." ++ mkPrivateName)
-> pbranchName
-> locals
+> addParams2Prefixes aesopCtlPrefix
+> (pwaitName ++ "." ++ mkPrivateName)
+> pbranchName
+> locals
> stmt
> else
@@ -720,16 +732,16 @@ runfun(ctl->fields.a, ctl->fields.b, ctl->fields.c, ctl->fields.d);
> | otherwise = stmt
> trPWaitLocals :: BlockingContext -> CStat -> CStat
-> trPWaitLocals bctx stmt
+> trPWaitLocals bctx stmt
> | isPWaitContext bctx || parentIsPWait bctx =
-> let pwaitCtx = if isPWaitContext bctx then bctx else parent bctx
+> let pwaitCtx = if isPWaitContext bctx then bctx else parent bctx
> mkLocals f = join $ map getCDeclNames $ f $ pwaitStmt pwaitCtx
> fdef = funDef $ getParent bctx
-> privateLocals = mkLocals getPWaitPrivateDecls
+> privateLocals = mkLocals getPWaitPrivateDecls
> sharedLocals = mkLocals getPWaitSharedDecls
> privatePWaitName = mkPrivatePWaitName $ getPWaitId fdef $ pwaitStmt pwaitCtx
> sharedPWaitName = mkSharedPWaitName $ getPWaitId fdef $ pwaitStmt pwaitCtx
-> privatePrefixedStmt = addParamsPrefixes
+> privatePrefixedStmt = addParamsPrefixes
> aesopCtlPrefix
> privatePWaitName
> privateLocals
@@ -739,20 +751,20 @@ runfun(ctl->fields.a, ctl->fields.b, ctl->fields.c, ctl->fields.d);
> sharedPWaitName
> sharedLocals
> privatePrefixedStmt
-> in allPrefixedStmt
+> in allPrefixedStmt
> | otherwise = stmt
> trFunLocals :: BlockingContext -> CStat -> CStat
-> trFunLocals bctx stmt =
-> let locals = join $ map getCDeclNames $ getLocals bctx
-> in (addParamsPtrPrefixes aesopCtlPrefix aesopParamsPrefix locals) stmt
+> trFunLocals bctx stmt =
+> let locals = join $ map getCDeclNames $ getLocals bctx
+> in (addParamsPtrPrefixes aesopCtlPrefix aesopParamsPrefix locals) stmt
> trLocals :: BlockingContext -> CStat -> CStat
> trLocals b = (trFunLocals b) . (trPWaitLocals b) . (trPBranchLocals b)
> trExpr :: BlockingContext -> Maybe CExpr -> Maybe CExpr
> trExpr bctx expr = if isJust expr then resExpr else expr
-> where ni = nodeInfo $ fromJust expr
+> where ni = nodeInfo $ fromJust expr
> (CExpr resExpr _) = trLocals bctx (CExpr expr ni)
> getFuncLocalDecls :: CFunDef -> [CDecl]
@@ -774,9 +786,9 @@ params->val = val;
> -- get the function parameters, and set the parameters in the
> -- params struct to the values passed in
> let withPrefix name ni = addStructPtrToAssign aesopCtlPrefix
-> aesopParamsPrefix
+> aesopParamsPrefix
> name
-> (CVar name ni)
+> (CVar name ni)
> genParam decl = withPrefix (getCDeclName decl) (nodeInfo decl)
> funParams = map genParam $ concat (map splitDecls fdecls)
@@ -815,7 +827,7 @@ This is the case where the function returns void (no second paramter for the cal
> mkBlockingStmts bctx funDef (CVoidType _, []) ni = do
> let (fname, retType, params) = getFunInfo funDef
> locals = getFunLocalDeclarations funDef
-> inits <- mkStmtsFromBlocking
+> inits <- mkStmtsFromBlocking
> "AE_MK_BFUN_INIT_BLOCK" [identToString fname] ni
> workerInvoke <- mkStmtsFromBlocking
> "AE_MK_BFUN_INVOKE_WORKER_VOIDFN" [identToString fname] ni
@@ -827,7 +839,7 @@ Normal non-void function
> mkBlockingStmts bctx funDef (ret, derived) ni = do
> let (fname, retType, params) = getFunInfo funDef
> locals = getFunLocalDeclarations funDef
-> inits <- mkStmtsFromBlocking
+> inits <- mkStmtsFromBlocking
> "AE_MK_BFUN_INIT_BLOCK" [identToString fname] ni
> workerInvoke <- mkStmtsFromBlocking
> "AE_MK_BFUN_INVOKE_WORKER" [identToString fname, returnToString retType] ni
@@ -849,58 +861,58 @@ Normal non-void function
> mkRetParam (ret, derived) ni = [mkCDecl ret ((CPtrDeclr [] ni) : derived) "__ae_retvalue" ni]
> mkCBParam :: (CTypeSpec, [CDerivedDeclr]) -> NodeInfo -> [CDecl]
-> mkCBParam (CVoidType _, []) ni =
-> [mkVoidFunPtr "__ae_callback" [constructDeclFromC ni "void *user_ptr;"]]
-> mkCBParam return ni =
-> [mkVoidFunPtr "__ae_callback"
-> [constructDeclFromC ni "void *user_ptr;", mkCDecl (fst return) (snd return) "__ae_ret" ni]]
+> mkCBParam (CVoidType _, []) ni =
+> [mkVoidFunPtr "__ae_callback" [constructDeclFromC ni "void *user_ptr;"]]
+> mkCBParam return ni =
+> [mkVoidFunPtr "__ae_callback"
+> [constructDeclFromC ni "void *user_ptr;", mkCDecl (fst return) (snd return) "__ae_ret" ni]]
> mkBlockingParams :: (Ident, (CTypeSpec, [CDerivedDeclr]), [CDecl]) -> WalkerT [CDecl]
> mkBlockingParams ((,,) fname ret params) = do
-> let ni = nodeInfo $ fst ret
+> let ni = nodeInfo $ fst ret
-> txParams <- sequence $ map translateBlockingFunParam $ removeVoid params
+> txParams <- sequence $ map translateBlockingFunParam $ removeVoid params
> bParams <- mkBlockingParamsForFunction ret ni
-> return $ bParams ++ txParams
+> return $ bParams ++ txParams
> mkBlockingDecl :: (Ident, (CTypeSpec, [CDerivedDeclr]), [CDecl]) -> [CDeclSpec] -> WalkerT CDecl
> mkBlockingDecl f@((,,) fname ret params) declspecs = do
-> let ni = nodeInfo $ fst ret
-> fparams <- mkBlockingParams f
+> let ni = nodeInfo $ fst ret
+> fparams <- mkBlockingParams f
> ret <- mkBlockingRetType ni
-> return $ mkFunDeclWithDeclSpecs
-> (identToString fname)
-> ret []
-> (filterStdDeclSpecs declspecs)
-> fparams
+> return $ mkFunDeclWithDeclSpecs
+> (identToString fname)
+> ret []
+> (filterStdDeclSpecs declspecs)
+> fparams
> mkBlockingPtrDecl :: Bool -> (Ident, (CTypeSpec, [CDerivedDeclr]), [CDecl]) -> [CDeclSpec] -> WalkerT CDecl
> mkBlockingPtrDecl extern f@((,,) fname ret params) declspecs = do
-> let ni = nodeInfo $ fst ret
-> fparams <- mkBlockingParams f
+> let ni = nodeInfo $ fst ret
+> fparams <- mkBlockingParams f
> ret <- mkBlockingRetType ni
-> return $ mkFunPtrDeclWithDeclSpecs
-> (identToString fname)
-> ret []
-> ((filterStdDeclSpecs declspecs) ++
-> (if extern then [CStorageSpec $ CExtern ni] else []))
-> fparams
-> (if not extern then Just (identToString $ fname) else Nothing)
+> return $ mkFunPtrDeclWithDeclSpecs
+> (identToString fname)
+> ret []
+> ((filterStdDeclSpecs declspecs) ++
+> (if extern then [CStorageSpec $ CExtern ni] else []))
+> fparams
+> (if not extern then Just (identToString $ fname) else Nothing)
> mkBlockingFunction :: BlockingContext -> CFunDef -> WalkerT CExtDecl
> mkBlockingFunction bctx funDef = do
-> let decls = getFunDefParams funDef
-> ni = nodeInfo funDef
+> let decls = getFunDefParams funDef
+> ni = nodeInfo funDef
> params <- sequence $ map translateBlockingFunParam $ removeVoid decls
-> blockingParams <- mkBlockingParamsForFunction (getFunDefReturn funDef) (nodeInfo funDef)
+> blockingParams <- mkBlockingParamsForFunction (fromJust $ getFunDefReturnMaybe funDef) (nodeInfo funDef)
> body <- mkBlockingBody bctx funDef
> ret <- mkBlockingRetType ni
-> return $ mkFunDef (ret, []) -- return type
-> (getStdDeclSpecs funDef) -- get the storage specifiers for the function
-> (mkBlockingFunName aesopParamsPrefix $ getFunDefName funDef) -- function name
-> (blockingParams ++ params)
-> body -- statements
+> return $ mkFunDef (ret, []) -- return type
+> (getStdDeclSpecs funDef) -- get the storage specifiers for the function
+> (mkBlockingFunName aesopParamsPrefix $ getFunDefName funDef) -- function name
+> (blockingParams ++ params)
+> body -- statements
> removeDerivedFun :: [CDerivedDeclr] -> [CDerivedDeclr]
> removeDerivedFun (d:ds) | isDerivedFun d = ds
@@ -925,31 +937,31 @@ Normal non-void function
> generateCallbackDeclForBlocking :: BlockingContext -> CExpr -> WalkerT CExtDecl
> generateCallbackDeclForBlocking b blockingCall = do
-
+
> wdebug $ "[generateCallbackDeclForBlocking]: call: " ++ (show $ getCallName $ blockingCall)
-> blockingFun <- lookupBlocking $ blockingCall
-> assert (isJust blockingFun) $ return ()
+> blockingFun <- lookupBlocking $ blockingCall
+> assert (isJust blockingFun) $ return ()
>
-> let (Just ((,,) bname retType params)) = blockingFun
+> let (Just ((,,) bname retType params)) = blockingFun
> wdebug $ "[generateCallbackDeclForBlocking]: fun: " ++ (show bname)
-> return $ mkCallbackDecl b blockingCall retType
+> return $ mkCallbackDecl b blockingCall retType
> generateCallbackDecls :: BlockingContext -> [CExpr] -> WalkerT [CExtDecl]
-> generateCallbackDecls b blockingCalls = do
+> generateCallbackDecls b blockingCalls = do
> sequence $ map (generateCallbackDeclForBlocking b) blockingCalls
> generateCallbackForBlocking :: BlockingContext -> CExpr -> WalkerT [CExtDecl]
> generateCallbackForBlocking b blockingCall = do
-> -- lookup the declaration of the blocking function call
+> -- lookup the declaration of the blocking function call
> -- to get the return type and parameter types
-> blockingFun <- lookupBlocking $ blockingCall
-> assert (isJust blockingFun) $ return ()
-> let (Just ((,,) bname retType params)) = blockingFun
+> blockingFun <- lookupBlocking $ blockingCall
+> assert (isJust blockingFun) $ return ()
+> let (Just ((,,) bname retType params)) = blockingFun
> ni = getCallNodeInfo blockingCall
> fname = getCallName blockingCall
> cbFunName = mkCallbackFunName (getParentName b) fname ni
> cbRetParam = mkCallbackRetParam fname ni
-> fRetType = getFunDefReturn $ funDef $ getParent b
+> fRetType = fromJust $ getFunDefReturnMaybe $ funDef $ getParent b
> fRetStr = returnToString fRetType
> retStr = returnToString retType
> bfunName = getParentName b
@@ -1062,7 +1074,7 @@ a BlockingContext as we go along
> everywhereM (mkM $ swapReturn b) tx
> else return rstmt
> transformCall _ s = return s
-
+
> addPBranchStmts :: BlockingContext -> CStat -> WalkerT CStat
> addPBranchStmts bctx pb@(CPBranch stmt ni) = do
@@ -1126,7 +1138,7 @@ a BlockingContext as we go along
> addPWaitStmts bctx s = return s
> mkWorkerRetType :: NodeInfo -> WalkerT CTypeSpec
-> mkWorkerRetType ni = do
+> mkWorkerRetType ni = do
> prd <- mkWorkerRetDecl ni
> return $ fst $ getReturn prd
@@ -1184,16 +1196,16 @@ a BlockingContext as we go along
> generateWorkerDecl fname ni declspecs = do
> ret <- mkWorkerRetType ni
> fparams <- mkWorkerParams fname ni
-> return $ mkFunDeclWithDeclSpecs
+> return $ mkFunDeclWithDeclSpecs
> ("__ae_worker_" ++ fname)
-> ret []
-> (filterStdDeclSpecs declspecs)
-> fparams
+> ret []
+> (filterStdDeclSpecs declspecs)
+> fparams
> generateWorker :: CFunDef -> WalkerT CExtDecl
> generateWorker funDef@(CFunDef specs declr decls stmt ni) = do
-> let bctx = FunContext funDef
+> let bctx = FunContext funDef
> fname = getFunDefName funDef
> -- filter decls out of inits so that just init statements remain
@@ -1217,7 +1229,7 @@ a BlockingContext as we go along
> -- see (AE_MK_WORKER_PWAIT_START_STMTS, AE_MK_WORKER_PWAIT_END_STMTS)
> -- 5) swap all pbreaks with the transformed statements
> -- see (AE_MK_WORKER_PBREAK)
-> -- 6) swap the return statement with
+> -- 6) swap the return statement with
> -- the transformed statements (see AE_MK_WORKER_RETURN)
> let combinedTransform b = (trLocalsM b) <=<
@@ -1246,74 +1258,81 @@ a BlockingContext as we go along
> transformBlocking fdefext@(CFDefExt funDef)
> -- A blocking function definition, so we transform it
-> | isBlockingFunDef funDef = do
+> | isBlockingFunDef funDef = do
> isValidBlockingFunDef funDef
> wdebug $ "[transform start]: " ++ (getFunDefName funDef)
-> -- register a blocking function with its parameters and return type
-> registerBlocking ((getFunDefIdent funDef),
-> (getFunDefReturn funDef),
-> (getFunDefParams funDef))
-> -- Find any blocking function pointers as parameters to the blocking function,
-> -- and register them
-> mapM_ registerBlockingFunParam $ getFunDefParams funDef
+> if (isNothing $ getFunDefReturnMaybe funDef) then do
+> invalid "function lacks return type" (nodeInfo fdefext)
+> return []
+> else do
+
+> -- register a blocking function with its parameters and return type
+> registerBlocking ((getFunDefIdent funDef),
+> (fromJust $ getFunDefReturnMaybe funDef),
+> (getFunDefParams funDef))
-> -- Register function parameters as local variables
-> addLocals $ getFunDefParams funDef
+> -- Find any blocking function pointers as parameters to the blocking function,
+> -- and register them
+> mapM_ registerBlockingFunParam $ getFunDefParams funDef
-> -- Register function local variables
-> addLocals $ getFunLocalDeclarations funDef
+> -- Register function parameters as local variables
+> addLocals $ getFunDefParams funDef
-> -- before generating the context, we add a return; statement at the end if its
-> -- a void function and doesn't have a return
-> fDefWReturn <- checkForReturn funDef
+> -- Register function local variables
+> addLocals $ getFunLocalDeclarations funDef
-> -- Generate the blocking tree of BlockingContext nodes
-> bcalls <- getAllBlockingCalls fDefWReturn
+> -- before generating the context, we add a return; statement at the end if its
+> -- a void function and doesn't have a return
-> let bctx = FunContext fDefWReturn
+> fDefWReturn <- checkForReturn funDef
-> -- Walk the tree, and generate the callback function declarations
-> callbackDecls <- generateCallbackDecls bctx bcalls
+> -- Generate the blocking tree of BlockingContext nodes
+> bcalls <- getAllBlockingCalls fDefWReturn
-> -- Walk the tree, and generate the callback function definitions
-> callbackDefs <- generateCallbackDefs bctx bcalls
+> let bctx = FunContext fDefWReturn
-> workerDecl <- generateWorkerDecl
+> -- Walk the tree, and generate the callback function declarations
+> callbackDecls <- generateCallbackDecls bctx bcalls
+
+> -- Walk the tree, and generate the callback function definitions
+> callbackDefs <- generateCallbackDefs bctx bcalls
+
+> workerDecl <- generateWorkerDecl
> (getFunDefName fDefWReturn)
> (nodeInfo fDefWReturn)
> (getDeclSpecs fDefWReturn)
-> workerDef <- generateWorker fDefWReturn
+> workerDef <- generateWorker fDefWReturn
-> -- Make the blocking params structure declaration
-> paramsStruct <- mkBlockingParamsStruct fDefWReturn
-> returnParamsStruct <- mkBlockingRetParamsStruct fDefWReturn bcalls
-> pwaitStructs <- mkBlockingPWaitStructs fDefWReturn
-> ctlStruct <- mkBlockingCtlStruct fDefWReturn True
+> -- Make the blocking params structure declaration
+> paramsStruct <- mkBlockingParamsStruct fDefWReturn
+> returnParamsStruct <- mkBlockingRetParamsStruct fDefWReturn bcalls
+> pwaitStructs <- mkBlockingPWaitStructs fDefWReturn
+> ctlStruct <- mkBlockingCtlStruct fDefWReturn True
-> let ni = nodeInfo fDefWReturn
-> fi = getFunInfo fDefWReturn
-> specs = map CStorageSpec (getStorageSpecs fDefWReturn)
+> let ni = nodeInfo fDefWReturn
+> fi = getFunInfo fDefWReturn
+> specs = map CStorageSpec (getStorageSpecs fDefWReturn)
-> blockingFun <- mkBlockingFunction bctx fDefWReturn
-> blockingDecl <- mkBlockingDecl fi specs
-> -- pPtrDecl <- mkBlockingPtrDecl False fi specs
+> blockingFun <- mkBlockingFunction bctx fDefWReturn
+> blockingDecl <- mkBlockingDecl fi specs
+> -- pPtrDecl <- mkBlockingPtrDecl False fi specs
-> -- Construct the external declarations of parameters, callback functions, and post function
-> let transformedDecls = pwaitStructs ++ [paramsStruct, returnParamsStruct, ctlStruct] ++ callbackDecls ++
-> [CDeclExt workerDecl, CDeclExt blockingDecl] ++
-> callbackDefs ++ [workerDef, blockingFun]
+> -- Construct the external declarations of parameters, callback functions, and post function
+> let transformedDecls = pwaitStructs ++ [paramsStruct, returnParamsStruct, ctlStruct] ++ callbackDecls ++
+> [CDeclExt workerDecl, CDeclExt blockingDecl] ++
+> callbackDefs ++ [workerDef, blockingFun]
-> -- Clear the blocking function parameters registry
-> resetLocals
-> clearLocalFunPtrRegistry
+> -- Clear the blocking function parameters registry
+> resetLocals
+> clearLocalFunPtrRegistry
-> wdebug $ "[transform end]: " ++ (getFunDefName funDef)
+> wdebug $ "[transform end]: " ++ (getFunDefName funDef)
-> return transformedDecls
+> return transformedDecls
| defHasBlockingFunPtrParam funDef = do
let (fname, (rtype, derived), ps) = getFunInfo funDef
@@ -1323,55 +1342,55 @@ a BlockingContext as we go along
let newDef = mkFunDef (rtype, derived) specs fname newps stmt
return [newDef]
-> | otherwise =
+> | otherwise =
> liftM ((:[]) . CFDefExt) $ everywhereM (mkM translateBlockingFunParam) funDef
> transformBlocking c = return [c]
-> transform :: CTranslUnit -> WalkerT CTranslUnit
+> transform :: CTranslUnit -> WalkerT CTranslUnit
> transform (CTranslUnit decls ni) = do
> -- map transformBlockingDef decls returns: [WalkerT [CExtDecl]]
> -- sequence of that returns: WalkerT [[CExtDecl]]
> -- so we lift concat into a monad so that we end up with WalkerT [CExtDecl]
-> newdecls <- liftM concat $ sequence $ map transformBlocking decls
-> return $ CTranslUnit newdecls ni
+> newdecls <- liftM concat $ sequence $ map transformBlocking decls
+> return $ CTranslUnit newdecls ni
> printBlocking :: Int -> FPType -> WalkerT ()
> printBlocking l (FPFun n f) = do
-> let (bname, (rettype, derives), params) = f
+> let (bname, (rettype, derives), params) = f
> pstr = if null params then "" else (foldl1 ((++) . (++ ", ")) $ map (show . pretty) params)
-> liftIO $ print $ (take l $ repeat ' ') ++ (show bname) ++ "( " ++ pstr ++ " ) = " ++ (show . pretty $ rettype)
+> liftIO $ print $ (take l $ repeat ' ') ++ (show bname) ++ "( " ++ pstr ++ " ) = " ++ (show . pretty $ rettype)
> printBlocking l (FPStruct n f i) = do
-> liftIO $ print $ (take l $ repeat ' ') ++ "( " ++ (show n) ++ " )->" ++ (show f)
-> printBlocking (l + 4) i
+> liftIO $ print $ (take l $ repeat ' ') ++ "( " ++ (show n) ++ " )->" ++ (show f)
+> printBlocking (l + 4) i
> printRegisteredBlockingCalls :: WalkerT ()
> printRegisteredBlockingCalls = do
-> blocking <- getAllBlocking
-> liftIO $ print "BLOCKING FUNCTIONS:"
-> mapM_ (printBlocking 0) blocking
+> blocking <- getAllBlocking
+> liftIO $ print "BLOCKING FUNCTIONS:"
+> mapM_ (printBlocking 0) blocking
> generateAST :: FilePath -> IO CTranslUnit
> generateAST input_file = do
-> input_stream <- readInputStream input_file
-> let parse_result = parseC input_stream (position 0 input_file 1 1)
+> input_stream <- readInputStream input_file
+> let parse_result = parseC input_stream (position 0 input_file 1 1)
> case parse_result of
> Left parse_err -> error $ "Parse failed for input file: " ++ input_file ++ ": " ++ (show parse_err)
> Right ast -> return ast
> parseHeader :: Bool -> String -> FilePath -> Maybe FilePath -> FilePath -> [String]-> IO ()
> parseHeader debug compiler headerfile report outfile gccopts = do
-> let r = if isJust report then fromJust report else headerfile
-> ctu <- generateAST headerfile
+> let r = if isJust report then fromJust report else headerfile
+> ctu <- generateAST headerfile
> let tdIdents = getTypeDefIdents ctu
-> w <- newWalkerState debug r compiler "aesop/ae-blocking-parser.h" gccopts tdIdents
-> (pairs, w) <- runStateT (getBlockingHeaderDecls ctu) w
-> writeFile outfile "\n\n/* This is an auto-generated file created by the ae-blocking-parser tool. DO NOT MODIFY! */\n\n"
-> outputHeader r outfile pairs
-> appendFile outfile "\n\n"
+> w <- newWalkerState debug r compiler "aesop/ae-blocking-parser.h" gccopts tdIdents
+> (pairs, w) <- runStateT (getBlockingHeaderDecls ctu) w
+> writeFile outfile "\n\n/* This is an auto-generated file created by the ae-blocking-parser tool. DO NOT MODIFY! */\n\n"
+> outputHeader r outfile pairs
+> appendFile outfile "\n\n"
> assert (isJust $ blockingParser w) return ()
> removeFile $ macheader $ fromJust $ blockingParser w
-> return ()
+> return ()
> isAesopInit :: CExtDecl -> Bool
> isAesopInit (CDeclExt d) = any ((== "aesop_init") . identToString) $ getCDeclNames d
@@ -1387,27 +1406,27 @@ a BlockingContext as we go along
> parseFile :: Bool -> Bool -> String -> FilePath -> Maybe FilePath -> [String] -> FilePath -> IO ()
> parseFile debug p compiler outfile report gccopts f = do
-> let r = if isJust report then fromJust report else f
-> ctu <- generateAST f
+> let r = if isJust report then fromJust report else f
+> ctu <- generateAST f
> let typeDefIdents = getTypeDefIdents ctu
-> w <- newWalkerState debug r compiler "aesop/ae-blocking-parser.h" gccopts typeDefIdents
+> w <- newWalkerState debug r compiler "aesop/ae-blocking-parser.h" gccopts typeDefIdents
> let extDecls (CTranslUnit d _) = d
> let (preBlockingCTU, mainCTU) = splitExtDeclsAtAesop ctu
> let (CTranslUnit mainExtDecls _) = mainCTU
> when (null mainExtDecls) $
> error $ "Parse failed for " ++ f ++ ": missing aesop_init() function. " ++
> "Must include aesop.h in all aesop source and header files.\n"
-> (ctuWithPostDecls, w) <- runStateT (registerBlockingFunDecls mainCTU) w
+> (ctuWithPostDecls, w) <- runStateT (registerBlockingFunDecls mainCTU) w
> -- runStateT (printRegisteredBlockingCalls) w
-> (transCTU, w) <- runStateT (transform ctuWithPostDecls) w
+> (transCTU, w) <- runStateT (transform ctuWithPostDecls) w
> writeFile outfile $ "\n\n\
> \/* This is an auto-generated source file create by the ae-blocking-parser tool. DO NOT MODIFY! */\n\n"
-> if p then ((appendFile outfile) . show . pretty) (mergeCTUs preBlockingCTU transCTU)
-> else ((appendFile outfile) . show . serialize) (mergeCTUs preBlockingCTU transCTU)
-> appendFile outfile "\n\n"
+> if p then ((appendFile outfile) . show . pretty) (mergeCTUs preBlockingCTU transCTU)
+> else ((appendFile outfile) . show . serialize) (mergeCTUs preBlockingCTU transCTU)
+> appendFile outfile "\n\n"
> assert (isJust $ blockingParser w) return ()
> removeFile $ macheader $ fromJust $ blockingParser w
-> return ()
+> return ()
> data ParserOpts = Debug | Pretty | Help | Report String | Outfile String | Infile String | Header | Compiler String
@@ -1434,19 +1453,19 @@ a BlockingContext as we go along
> parserOpts :: [OptDescr ParserOpts]
> parserOpts =
> [ Option ['p'] ["pretty"] (NoArg Pretty)
-> "output in pretty form without source line macros"
+> "output in pretty form without source line macros"
> , Option ['h','?'] ["help"] (NoArg Help)
-> "help text"
+> "help text"
> , Option ['r'] ["report"] (ReqArg (\s -> Report s) "<report filename>")
-> "filename to use when reporting errors"
+> "filename to use when reporting errors"
> , Option ['o'] ["outfile"] (ReqArg (\s -> Outfile s) "<output file>")
-> "filename to write translated C code"
+> "filename to write translated C code"
> , Option ['i'] ["infile"] (ReqArg (\s -> Infile s) "<input file>")
-> "input filename to translate"
+> "input filename to translate"
> , Option ['c'] ["compiler"] (ReqArg (\s -> Compiler s) "<compiler>")
> "compiler"
> , Option ['j'] ["header"] (NoArg Header)
-> "parse header file instead of source"
+> "parse header file instead of source"
> , Option ['d'] ["debug"] (NoArg Debug)
> "output debugging info (very verbose!)"
> ]
@@ -1470,19 +1489,19 @@ a BlockingContext as we go along
> main :: IO ()
> main = do
> args <- getArgs
-> let (opts, gccopts, errs) = getOpt RequireOrder parserOpts args
-> pretty = any optPretty opts
-> help = any optHelp opts
-> report = getReportFilename opts
-> outfile = getOutfile opts
+> let (opts, gccopts, errs) = getOpt RequireOrder parserOpts args
+> pretty = any optPretty opts
+> help = any optHelp opts
+> report = getReportFilename opts
+> outfile = getOutfile opts
> input = getInfile opts
-> pheader = any optHeader opts
+> pheader = any optHeader opts
> debug = any optDebug opts
> compiler = getCompiler opts
-> header = "Usage: ae-blocking-parser [OPTIONS...] files..."
+> header = "Usage: ae-blocking-parser [OPTIONS...] files..."
> when (not $ null errs) $ ioError $ userError ((concat errs) ++
-> (usageInfo header parserOpts))
-> when help $ do { putStrLn $ usageInfo header parserOpts ; exitWith (ExitFailure 1) }
+> (usageInfo header parserOpts))
+> when help $ do { putStrLn $ usageInfo header parserOpts ; exitWith (ExitFailure 1) }
> when (isNothing input) $ ioError $ userError "No input file specified."
> when (isNothing outfile) $ ioError $ userError "No output file specified."
diff --git a/src/aesop/parser/README.txt b/src/aesop/parser/README.txt
new file mode 100644
index 0000000..e0e9407
--- /dev/null
+++ b/src/aesop/parser/README.txt
@@ -0,0 +1,31 @@
+
+How to install the necessary Haskell libraries for Aesop:
+
+1) Install cabal
+
+a) Install the easy way:
+apt-get install cabal-install
+
+or:
+b) Set up a local cabal installation:
+./maint/hs/setup-cabal-local
+
+2) Set up the required Haskell libraries
+./maint/hs/setup-hs-local
+
+3) Set up Aesop:
+./maint/hs/setup-aesop
+
+On a given workstation OS installation, steps 1) and 2) are applied
+only once. Step 3) is applied for each working directory.
+
+On systems without Haskell binary packages (ghc), you'll need to do:
+
+* Download/Build/Install ghc from http://www.haskell.org/ghc/
+* Download/Build/Install MTL from http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl
+* Download/Build/Install happy from http://www.haskell.org/happy/
+* Download/Build/Install alex from http://www.haskell.org/alex/
+
+* Then run: setup-aesop
+
+NOTE: Cabal is the recommended method.
diff --git a/src/c-utils b/src/c-utils
index 6bc8c1c..8b480ad 160000
--- a/src/c-utils
+++ b/src/c-utils
@@ -1 +1 @@
-Subproject commit 6bc8c1c32a4a0c777847e44d4e0bf12e2b38d20a
+Subproject commit 8b480ad06f857dfecd8aaa809704df97281378c0
hooks/post-receive
--
1
0
17 Aug '12
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "".
The branch, master has been updated
via c420e93e6e45b908282b3406a8a80ce8657f69ed (commit)
via cf0b4a176869e285dff3798777ace90c715cb177 (commit)
from c2674d6c8d3aa71ddb5467379279f0fdd32e4ddd (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit c420e93e6e45b908282b3406a8a80ce8657f69ed
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Fri Aug 17 10:48:18 2012 -0400
carry overy mmsghdr hack from triton
commit cf0b4a176869e285dff3798777ace90c715cb177
Author: Phil Carns <carns(a)mcs.anl.gov>
Date: Fri Aug 17 10:44:21 2012 -0400
carry over cflag and warning updates from triton
-----------------------------------------------------------------------
Summary of changes:
Makefile.in | 14 +++++++++-----
src/socket/aesocket.hae | 10 +++++++++-
2 files changed, 18 insertions(+), 6 deletions(-)
Diff of changes:
diff --git a/Makefile.in b/Makefile.in
index 01806ef..6eeee2e 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -85,22 +85,26 @@ CFLAGS= -I$(srcdir)/src/c-utils -I$(srcdir)/include -I. -Iinclude -I src/c-utils
CWARNS=
ifneq (0,$(STRICT_CFLAGS))
+ CWARNS += -Wall
CWARNS += -Wcast-align -Wbad-function-cast
CWARNS += -Wmissing-prototypes -Wmissing-declarations
CWARNS += -Wundef -Wpointer-arith
CWARNS += -Wnested-externs
CWARNS += -Wredundant-decls
- # Very noisy, too strict
- CWARNS += -W -Wno-sign-compare
+ # turn on extra warnings, minus a few things
+ CWARNS += -Wextra -Wno-unused-label -Wno-sign-compare -Wno-unused-parameter
CWARNS += -Wcast-qual
CWARNS += -Wshadow
CWARNS += -Wwrite-strings
CWARNS += -Wformat
+ CWARNS += -Wunused
endif
# don't want to warn when we call format functions without string literal parameters
# e.g. triton_string_init(&str, myname);
CWARNS += -Wno-format-security
+# also don't warn if we user zero-length formats in printf-style functions
+CWARNS += -Wno-format-zero-length
# ... or when we have unused labels, which are common in generated aesop
# code
CWARNS += -Wno-unused-label
@@ -179,10 +183,10 @@ else
VA="-v"
endif
+# note: aesop produces a lot of redundant-decl warnings that have nothing to
+# do with the user-written code, so we turn those off when using -Werror
ifeq ($(WARNINGS_AS_ERRORS),1)
- EWARNS = -Werror
-else
- EWARNS =
+ CWARNS += -Werror -Wno-redundant-decls
endif
# PHONY targets are targets that do not result in the generation
diff --git a/src/socket/aesocket.hae b/src/socket/aesocket.hae
index 1fe2ca5..0993c21 100644
--- a/src/socket/aesocket.hae
+++ b/src/socket/aesocket.hae
@@ -8,9 +8,17 @@
#define SOCKET_TRITON_SOCKET_HAE
#include <sys/types.h>
-#include <sys/socket.h>
#include <aesop/aesop.h>
+/* NOTE: this is a hack. For some reason the aesop translator
+ * produces a warning about mmsghdr being undefined in socket.h on some
+ * systems, even though we use no functions that that struct, and
+ * regardless * of whether __USE_GNU is defined or not. Putting a
+ * forward declaration here works around the problem. -Phil
+ */
+struct mmsghdr;
+#include <sys/socket.h>
+
/**
* Prepare fd for use with the functions in the triton-socket module.
hooks/post-receive
--
1
0
17 Aug '12
[Apologies if you received multiple copies of this email. ]
-------------------------------------------------------------------
The 7th Parallel Data Storage Workshop (PDSW12)
held in conjunction with IEEE/ACM Supercomputing (SC) 2012
Salt Lake City, Utah, Monday, November 12, 2012
-------------------------------------------------------------------
URL: http://www.pdsw.org
Peta- and exascale computing infrastructures make unprecedented demands on storage capacity, performance, concurrency, reliability, availability, and manageability. This one-day workshop focuses on the data storage problems and emerging solutions found in peta- and exascale scientific computing environments, with special attention to issues in which community collaboration can be crucial for problem identification, workload capture, solution interoperability, standards with community buy-in, and shared tools. This workshop seeks contributions on relevant topics, including but not limited to:
- performance and benchmarking
- failure tolerance problems and solutions
- APIs for high performance features
- parallel file systems
- high bandwidth storage architectures
- wide area file systems
- metadata intensive workloads
- autonomics for HPC storage
- virtualization for storage systems
- archival storage advances
- resource management innovations
- storage systems for big data and analytics
- incorporation of emerging storage technologies
Paper Submissions:
The Parallel Data Storage Workshop holds a peer reviewed competitive process for selecting short papers. Submit a not previously published short paper of up to 5 pages, not less than 10 point font, in a PDF file as instructed on the workshop web site. Submitted papers will be reviewed under the supervision of the workshop program committee. Submissions should indicate authors and affiliations. Final papers must not be longer than 5 pages. Selected papers and associated talk slides will be made available on the workshop web site; the papers will also be published in the digital library of the IEEE or ACM.
Paper Submission Deadline: Sun, Sept. 30, 2012, 11:59 p.m. EDT (no extensions)
Paper Notification: Wed, Oct. 17, 2012
Camera Ready Due: Wed, Nov. 7, 2012
Softcopy and Slides Due: November 10, 2012, 5:00 pm ET, BEFORE the workshop
Poster Submissions:
There will also be a poster session at the workshop; accepted papers will ALWAYS be accepted for a poster. Others interested in presenting a related technical poster (posters with technical results for storage products are also encouraged) should submit a short poster abstract as instructed on the workshop web site.
Poster Submission Deadline: Thursday, November 6, 2012
Poster Notification: November 8, 2012
Program Committee:
Robert Ross, Argonne National Laboratory (PC Chair)
Ahmed Amer, University of California, Santa Clara
John Bent, EMC
Yong Chen, Texas Tech University
Matthew Curry, Sandia National Laboratories
Garth Gibson, Carnegie Mellon University and Panasas Inc.
Dean Hildebrand, IBM
Dries Kimpe, Argonne National Laboratory
Xiaosong Ma, North Carolina State University
Carlos Maltzahn, University of California, Santa Cruz
Narasimha Reddy, Texas A&M University
Brad Settlemyer, Oak Ridge National Laboratory
Galen Shipman, Oak Ridge National Laboratory
Matthew Wolf, Georgia Institute of Technology
Sage Weil, DreamHost
Bill Kramer, National Center for Supercomputing Applications/University of Illinois Urbana-Champaign
1
0
Hi Phil,
No durability on the db yet. Is in progress.
--Lee
-----Original Message-----
From: Phil Carns [carns(a)mcs.anl.gov<mailto:[email protected]>]
Sent: Monday, August 13, 2012 01:01 PM Mountain Standard Time
To: asg(a)lists.mcs.anl.gov
Subject: [EXTERNAL] Re: [ASG] IDB + Localstore API
Hi Matthew,
I apologize for the delay, but I just started looking at the libidb code. It compiles cleanly and I am able to run the test programs.
I have one quick initial question, though. Just from doing a quick "strace ./idb 1" (ie, tracing the system calls associated with inserting a single extent into an IDB database) I don't see fsync() or fdatasync() calls. Is the benchmark doing anything to make sure that updates are durable on disk?
thanks,
-Phil
On 07/03/2012 06:32 PM, Curry, Matthew Leon wrote:
These materials are for the localstore call on Thursday. If you don't plan to attend that call, you may stop reading and breathe a sigh of relief. :)
At the bottom of this mail, I've attached a description of the localstore API that is currently under development. There may be a couple of errors, but nothing major. It needs extension to accommodate variable-sized key-value storage, but I think this will be a straightforward modification.
I've also grabbed a stable copy of IDB out of our repo. Geoff has some work going on that adds precommit support, along with a reapportionment of space in on-disk nodes to support flags, but this version suffices for our discussions.
As for performance testing, I did the following for a range of database sizes:
1) Generate a database by {randomly | sequentially} inserting non-colliding intervals
2) Query the {random | sequential} database by stabbing in the middle of an interval {randomly | sequentially}
One obvious improvement is to make the first type of test into:
1) Generate a database by {randomly | sequentially} inserting {non-colliding | colliding} intervals.
I'm looking forward to the call on Thursday.
Matthew
_______________________________________________
ASG mailing list
ASG(a)lists.mcs.anl.gov<mailto:[email protected]>
https://lists.mcs.anl.gov/mailman/listinfo/asg
2
3
These materials are for the localstore call on Thursday. If you don't plan to attend that call, you may stop reading and breathe a sigh of relief. :)
At the bottom of this mail, I've attached a description of the localstore API that is currently under development. There may be a couple of errors, but nothing major. It needs extension to accommodate variable-sized key-value storage, but I think this will be a straightforward modification.
I've also grabbed a stable copy of IDB out of our repo. Geoff has some work going on that adds precommit support, along with a reapportionment of space in on-disk nodes to support flags, but this version suffices for our discussions.
As for performance testing, I did the following for a range of database sizes:
1) Generate a database by {randomly | sequentially} inserting non-colliding intervals
2) Query the {random | sequential} database by stabbing in the middle of an interval {randomly | sequentially}
One obvious improvement is to make the first type of test into:
1) Generate a database by {randomly | sequentially} inserting {non-colliding | colliding} intervals.
I'm looking forward to the call on Thursday.
Matthew
5
13