Reorganisation of the source tree

Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.

The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level.  The build system now makes no
pretense at being multi-project, it is just the GHC build system.

No doubt this will break many things, and there will be a period of
instability while we fix the dependencies.  A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.

1 files changed, 198 insertions, 0 deletions

diff --git a/includes/ClosureMacros.h b/includes/ClosureMacros.h
new file mode 100644
index 0000000000..f40f6aace6
--- /dev/null
+++ b/includes/ClosureMacros.h
@@ -0,0 +1,198 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2004
+ *
+ * Macros for building and manipulating closures
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef CLOSUREMACROS_H
+#define CLOSUREMACROS_H
+
+/* Say whether the code comes before the heap; on mingwin this may not be the
+   case, not because of another random MS pathology, but because the static
+   program may reside in a DLL
+*/
+
+/* -----------------------------------------------------------------------------
+   Info tables are slammed up against the entry code, and the label
+   for the info table is at the *end* of the table itself.  This
+   inline function adjusts an info pointer to point to the beginning
+   of the table, so we can use standard C structure indexing on it.
+
+   Note: this works for SRT info tables as long as you don't want to
+   access the SRT, since they are laid out the same with the SRT
+   pointer as the first word in the table.
+
+   NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
+
+   A couple of definitions:
+
+       "info pointer"    The first word of the closure.  Might point
+                         to either the end or the beginning of the
+			 info table, depending on whether we're using
+			 the mini interpretter or not.  GET_INFO(c)
+			 retrieves the info pointer of a closure.
+
+       "info table"      The info table structure associated with a
+                         closure.  This is always a pointer to the
+			 beginning of the structure, so we can
+			 use standard C structure indexing to pull out
+			 the fields.  get_itbl(c) returns a pointer to
+			 the info table for closure c.
+
+   An address of the form xxxx_info points to the end of the info
+   table or the beginning of the info table depending on whether we're
+   mangling or not respectively.  So, 
+
+         c->header.info = xxx_info 
+
+   makes absolute sense, whether mangling or not.
+ 
+   -------------------------------------------------------------------------- */
+
+#define SET_INFO(c,i) ((c)->header.info = (i))
+#define GET_INFO(c)   ((c)->header.info)
+#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
+
+#define get_itbl(c)   (INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
+
+#define GET_TAG(con) (get_itbl(con)->srt_bitmap)
+
+#ifdef TABLES_NEXT_TO_CODE
+#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
+#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
+#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
+#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
+#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#else
+#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
+#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
+#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
+#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
+#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
+#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
+#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
+#endif
+
+/* -----------------------------------------------------------------------------
+   Macros for building closures
+   -------------------------------------------------------------------------- */
+
+#ifdef PROFILING
+#ifdef DEBUG_RETAINER
+/* 
+  For the sake of debugging, we take the safest way for the moment. Actually, this 
+  is useful to check the sanity of heap before beginning retainer profiling.
+  flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
+  Note: change those functions building Haskell objects from C datatypes, i.e.,
+  all rts_mk???() functions in RtsAPI.c, as well.
+ */
+#define SET_PROF_HDR(c,ccs_)            \
+        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
+#else
+/*
+  For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
+  NULL | flip (flip is defined in RetainerProfile.c) because even when flip
+  is 1, rs is invalid and will be initialized to NULL | flip later when 
+  the closure *c is visited.
+ */
+/*
+#define SET_PROF_HDR(c,ccs_)            \
+        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
+ */
+/*
+  The following macro works for both retainer profiling and LDV profiling:
+  for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
+  See the invariants on ldvTime.
+ */
+#define SET_PROF_HDR(c,ccs_)            \
+        ((c)->header.prof.ccs = ccs_,   \
+        LDV_RECORD_CREATE((c)))
+#endif /* DEBUG_RETAINER */
+#define SET_STATIC_PROF_HDR(ccs_)       \
+        prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } },
+#else
+#define SET_PROF_HDR(c,ccs)
+#define SET_STATIC_PROF_HDR(ccs)
+#endif
+
+#ifdef GRAN
+#define SET_GRAN_HDR(c,pe)		(c)->header.gran.procs = pe
+#define SET_STATIC_GRAN_HDR		gran : { procs : Everywhere },
+#else
+#define SET_GRAN_HDR(c,pe)
+#define SET_STATIC_GRAN_HDR
+#endif
+
+#ifdef PAR
+#define SET_PAR_HDR(c,stuff)
+#define SET_STATIC_PAR_HDR(stuff)
+#else
+#define SET_PAR_HDR(c,stuff)
+#define SET_STATIC_PAR_HDR(stuff)
+#endif
+
+#ifdef TICKY_TICKY
+#define SET_TICKY_HDR(c,stuff)	     /* old: (c)->header.ticky.updated = stuff */
+#define SET_STATIC_TICKY_HDR(stuff)  /* old: ticky : { updated : stuff } */
+#else
+#define SET_TICKY_HDR(c,stuff)
+#define SET_STATIC_TICKY_HDR(stuff)
+#endif
+
+#define SET_HDR(c,_info,ccs)				\
+   {							\
+	(c)->header.info = _info;			\
+	SET_GRAN_HDR((StgClosure *)(c),ThisPE);		\
+	SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);	\
+	SET_PROF_HDR((StgClosure *)(c),ccs);		\
+	SET_TICKY_HDR((StgClosure *)(c),0);		\
+   }
+
+#define SET_ARR_HDR(c,info,costCentreStack,n_words)	\
+   SET_HDR(c,info,costCentreStack);			\
+   (c)->words = n_words;
+
+/* -----------------------------------------------------------------------------
+   How to get hold of the static link field for a static closure.
+   -------------------------------------------------------------------------- */
+
+/* These are hard-coded. */
+#define FUN_STATIC_LINK(p)   (&(p)->payload[0])
+#define THUNK_STATIC_LINK(p) (&(p)->payload[1])
+#define IND_STATIC_LINK(p)   (&(p)->payload[1])
+
+INLINE_HEADER StgClosure **
+STATIC_LINK(const StgInfoTable *info, StgClosure *p)
+{ 
+    switch (info->type) {
+    case THUNK_STATIC:
+	return THUNK_STATIC_LINK(p);
+    case FUN_STATIC:
+	return FUN_STATIC_LINK(p);
+    case IND_STATIC:
+	return IND_STATIC_LINK(p);
+    default:
+	return &(p)->payload[info->layout.payload.ptrs +
+			     info->layout.payload.nptrs];
+    }
+}
+
+#define STATIC_LINK2(info,p)							\
+   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +			\
+					info->layout.payload.nptrs + 1])))
+
+/* -----------------------------------------------------------------------------
+   INTLIKE and CHARLIKE closures.
+   -------------------------------------------------------------------------- */
+
+#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
+#define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
+
+#endif /* CLOSUREMACROS_H */