X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fmain%2FGranSim.lc;h=cdaee56da61a93fcdd0ff31427e77662fcc9a6f4;hb=b51d0528b6bcbfc770765c33eed3714fd91f23e8;hp=f8531aede740b312759f2b08a502b83b4b2fea16;hpb=063eda14b18aadc138bc27eb460e1af93b09ca9b;p=ghc-hetmet.git diff --git a/ghc/runtime/main/GranSim.lc b/ghc/runtime/main/GranSim.lc index f8531ae..cdaee56 100644 --- a/ghc/runtime/main/GranSim.lc +++ b/ghc/runtime/main/GranSim.lc @@ -2,7 +2,7 @@ % (c) The GRASP/AQUA Project, Glasgow University, 1995 - 1996 % Hans Wolfgang Loidl % -% Time-stamp: +% Time-stamp: % %************************************************************************ %* * @@ -20,7 +20,9 @@ which should be <= the length of a word in bits. -- HWL \begin{code} #if defined(GRAN) || defined(PAR) +#ifndef _AIX #define NON_POSIX_SOURCE /* gettimeofday */ +#endif #include "rtsdefs.h" @@ -77,6 +79,9 @@ char *proc_status_names[] = { unsigned CurrentProc = 0; rtsBool IgnoreEvents = rtsFalse; /* HACK only for testing */ +#if 0 && (defined(GCap) || defined(GCgn)) +closq ex_RBH_q = NULL; +#endif #endif /* GRAN */ \end{code} @@ -300,7 +305,7 @@ get_next_event() if(EventHd == NULL) { - fprintf(stderr,"No next event\n"); + fprintf(stderr,"No next event. This may be caused by a circular data dependency in the program.\n"); EXIT(EXIT_FAILURE); } @@ -432,7 +437,7 @@ grab_event() /* undo prepend_event i.e. get the event */ eventq event = EventHd; if(EventHd == NULL) { - fprintf(stderr,"No next event (in grab_event)\n"); + fprintf(stderr,"No next event (in grab_event). This may be caused by a circular data dependency in the program.\n"); EXIT(EXIT_FAILURE); } @@ -440,6 +445,50 @@ grab_event() /* undo prepend_event i.e. get the event */ return (event); } +void +traverse_eventq_for_gc() +{ + eventq event = EventHd; + W_ bufsize; + P_ closure, tso, buffer, bufptr; + PROC proc, creator; + + /* Traverse eventq and replace every FETCHREPLY by a FETCHNODE for the + orig closure (root of packed graph). This means that a graph, which is + between processors at the time of GC is fetched again at the time when + it would have arrived, had there been no GC. Slightly inaccurate but + safe for GC. + This is only needed for GUM style fetchng. */ + if (!RTSflags.GranFlags.DoGUMMFetching) + return; + + for(event = EventHd; event!=NULL; event=EVENT_NEXT(event)) { + if (EVENT_TYPE(event)==FETCHREPLY) { + buffer = EVENT_NODE(event); + ASSERT(buffer[PACK_FLAG_LOCN]==MAGIC_PACK_FLAG); /* It's a pack buffer */ + bufsize = buffer[PACK_SIZE_LOCN]; + closure= (P_)buffer[PACK_HDR_SIZE]; + tso = (P_)buffer[PACK_TSO_LOCN]; + proc = EVENT_PROC(event); + creator = EVENT_CREATOR(event); /* similar to unpacking */ + for (bufptr=buffer+PACK_HDR_SIZE; bufptr<(buffer+bufsize); + bufptr++) { + if ( (INFO_TYPE(INFO_PTR(*bufptr)) == INFO_SPEC_RBH_TYPE) || + (INFO_TYPE(INFO_PTR(*bufptr)) == INFO_GEN_RBH_TYPE) ) { + convertFromRBH((P_)*bufptr); + } + } + free(buffer); + EVENT_TYPE(event) = FETCHNODE; + EVENT_PROC(event) = creator; + EVENT_CREATOR(event) = proc; + EVENT_NODE(event) = closure; + EVENT_TSO(event) = tso; + EVENT_GC_INFO(event) = 0; + } + } +} + void print_event(event) eventq event; @@ -447,9 +496,9 @@ eventq event; char str_tso[16], str_node[16]; - sprintf(str_tso,((EVENT_TSO(event)==Prelude_Z91Z93_closure) ? "______" : "%#6lx"), + sprintf(str_tso,((EVENT_TSO(event)==PrelBase_Z91Z93_closure) ? "______" : "%#6lx"), EVENT_TSO(event)); - sprintf(str_node,((EVENT_NODE(event)==Prelude_Z91Z93_closure) ? "______" : "%#6lx"), + sprintf(str_node,((EVENT_NODE(event)==PrelBase_Z91Z93_closure) ? "______" : "%#6lx"), EVENT_NODE(event)); if (event==NULL) @@ -481,7 +530,7 @@ print_spark(spark) { char str[16]; - sprintf(str,((SPARK_NODE(spark)==Prelude_Z91Z93_closure) ? "______" : "%#6lx"), + sprintf(str,((SPARK_NODE(spark)==PrelBase_Z91Z93_closure) ? "______" : "%#6lx"), (W_) SPARK_NODE(spark)); if (spark==NULL) @@ -530,18 +579,18 @@ First some auxiliary routines. void ActivateNextThread (PROC proc) { - ASSERT(RunnableThreadsHd[proc]!=Prelude_Z91Z93_closure); + ASSERT(RunnableThreadsHd[proc]!=PrelBase_Z91Z93_closure); RunnableThreadsHd[proc] = TSO_LINK(RunnableThreadsHd[proc]); - if(RunnableThreadsHd[proc]==Prelude_Z91Z93_closure) { + if(RunnableThreadsHd[proc]==PrelBase_Z91Z93_closure) { MAKE_IDLE(proc); - RunnableThreadsTl[proc] = Prelude_Z91Z93_closure; + RunnableThreadsTl[proc] = PrelBase_Z91Z93_closure; } else { CurrentTime[proc] += RTSflags.GranFlags.gran_threadcontextswitchtime; if (RTSflags.GranFlags.granSimStats && (!RTSflags.GranFlags.Light || (RTSflags.GranFlags.debug & 0x20000))) DumpRawGranEvent(proc,0,GR_SCHEDULE,RunnableThreadsHd[proc], - Prelude_Z91Z93_closure,0); + PrelBase_Z91Z93_closure,0); } } \end{code} @@ -568,7 +617,7 @@ W_ liveness; if (RTSflags.GranFlags.granSimStats_Heap) { DumpRawGranEvent(CurrentProc,0,GR_ALLOC,CurrentTSO, - Prelude_Z91Z93_closure,n); + PrelBase_Z91Z93_closure,n); } TSO_EXECTIME(CurrentTSO) += RTSflags.GranFlags.gran_heapalloc_cost; @@ -696,8 +745,8 @@ P_ node; } } # endif - TSO_LINK(CurrentTSO) = Prelude_Z91Z93_closure; - /* CurrentTSO = Prelude_Z91Z93_closure; */ + TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure; + /* CurrentTSO = PrelBase_Z91Z93_closure; */ /* ThreadQueueHd is now the next TSO to schedule or NULL */ /* CurrentTSO is pointed to by the FETCHNODE event */ @@ -725,7 +774,7 @@ P_ node; } else { TSO_TYPE(CurrentTSO) |= FETCH_MASK_TSO; } - CurrentTSO = Prelude_Z91Z93_closure; + CurrentTSO = PrelBase_Z91Z93_closure; } # endif } @@ -747,13 +796,13 @@ P_ node; { /* ++SparksAvail; Nope; do that in add_to_spark_queue */ if(RTSflags.GranFlags.granSimStats_Sparks) - DumpRawGranEvent(CurrentProc,(PROC)0,SP_SPARK,Prelude_Z91Z93_closure,node, + DumpRawGranEvent(CurrentProc,(PROC)0,SP_SPARK,PrelBase_Z91Z93_closure,node, spark_queue_len(CurrentProc,ADVISORY_POOL)-1); /* Force the PE to take notice of the spark */ if(RTSflags.GranFlags.DoAlwaysCreateThreads) { new_event(CurrentProc,CurrentProc,CurrentTime[CurrentProc], - FINDWORK,Prelude_Z91Z93_closure,Prelude_Z91Z93_closure,NULL); + FINDWORK,PrelBase_Z91Z93_closure,PrelBase_Z91Z93_closure,NULL); if (CurrentTime[CurrentProc]