From: stolz Date: Wed, 26 Jun 2002 08:18:45 +0000 (+0000) Subject: [project @ 2002-06-26 08:18:38 by stolz] X-Git-Tag: Approx_11550_changesets_converted~1930 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=fbbed914e114b6b55158319dca8956885f301ff5 [project @ 2002-06-26 08:18:38 by stolz] - Make TSO "stable" again: The thread label was changing the size of the TSO if you were building a debugging-RTS, leading to binary incompatibility. Now we map TSOs to strings using Hash.c. - API change for labelThread: Label arbitrary threads. --- diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp index a1ff417..ade88b4 100644 --- a/ghc/compiler/prelude/primops.txt.pp +++ b/ghc/compiler/prelude/primops.txt.pp @@ -1,5 +1,5 @@ ----------------------------------------------------------------------- --- $Id: primops.txt.pp,v 1.20 2002/06/18 13:58:24 simonpj Exp $ +-- $Id: primops.txt.pp,v 1.21 2002/06/26 08:18:38 stolz Exp $ -- -- Primitive Operations -- @@ -1442,7 +1442,7 @@ primop MyThreadIdOp "myThreadId#" GenPrimOp out_of_line = True primop LabelThreadOp "labelThread#" GenPrimOp - Addr# -> State# RealWorld -> State# RealWorld + ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld with has_side_effects = True out_of_line = True diff --git a/ghc/includes/TSO.h b/ghc/includes/TSO.h index 06e8636..19a162e 100644 --- a/ghc/includes/TSO.h +++ b/ghc/includes/TSO.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: TSO.h,v 1.26 2002/04/10 11:43:44 stolz Exp $ + * $Id: TSO.h,v 1.27 2002/06/26 08:18:41 stolz Exp $ * * (c) The GHC Team, 1998-1999 * @@ -178,9 +178,6 @@ typedef struct StgTSO_ { StgTSOBlockInfo block_info; struct StgTSO_* blocked_exceptions; StgThreadID id; -#ifdef DEBUG - char* label; -#endif StgTSOTickyInfo ticky; StgTSOProfInfo prof; diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index 0d2e752..44bedf6 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.98 2002/04/23 11:22:12 simonmar Exp $ + * $Id: PrimOps.hc,v 1.99 2002/06/26 08:18:41 stolz Exp $ * * (c) The GHC Team, 1998-2000 * @@ -1059,9 +1059,11 @@ FN_(myThreadIdzh_fast) FN_(labelThreadzh_fast) { FB_ - /* args: R1.p = Addr# */ + /* args: + R1.p = ThreadId# + R2.p = Addr# */ #ifdef DEBUG - STGCALL2(labelThread,CurrentTSO,(char *)R1.p); + STGCALL2(labelThread,(StgTSO *)R1.p,(char *)R2.p); #endif JMP_(ENTRY_CODE(Sp[0])); FE_ diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index 27ee47c..7b308ea 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsStartup.c,v 1.63 2002/05/11 00:16:12 sof Exp $ + * $Id: RtsStartup.c,v 1.64 2002/06/26 08:18:41 stolz Exp $ * * (c) The GHC Team, 1998-2000 * @@ -25,6 +25,7 @@ #include "Prelude.h" /* fixupRTStoPreludeRefs */ #include "HsFFI.h" #include "Linker.h" +#include "ThreadLabels.h" #if defined(RTS_GTK_FRONTPANEL) #include "FrontPanel.h" @@ -156,6 +157,9 @@ startupHaskell(int argc, char *argv[], void (*init_root)(void)) /* initialise the stable pointer table */ initStablePtrTable(); + /* initialise thread label table (tso->char*) */ + initThreadLabelTable(); + #if defined(PROFILING) || defined(DEBUG) initProfiling1(); #endif diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 7e281e9..530bdf9 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,5 +1,5 @@ /* --------------------------------------------------------------------------- - * $Id: Schedule.c,v 1.145 2002/06/19 20:45:15 sof Exp $ + * $Id: Schedule.c,v 1.146 2002/06/26 08:18:42 stolz Exp $ * * (c) The GHC Team, 1998-2000 * @@ -96,6 +96,7 @@ #include "Stats.h" #include "Itimer.h" #include "Prelude.h" +#include "ThreadLabels.h" #ifdef PROFILING #include "Proftimer.h" #include "ProfHeap.h" @@ -451,8 +452,7 @@ schedule( void ) m->stat = Success; broadcastCondition(&m->wakeup); #ifdef DEBUG - free(m->tso->label); - m->tso->label = NULL; + removeThreadLabel(m->tso); #endif break; case ThreadKilled: @@ -465,8 +465,7 @@ schedule( void ) } broadcastCondition(&m->wakeup); #ifdef DEBUG - free(m->tso->label); - m->tso->label = NULL; + removeThreadLabel(m->tso); #endif break; default: @@ -488,8 +487,7 @@ schedule( void ) if (m->tso->what_next == ThreadComplete || m->tso->what_next == ThreadKilled) { #ifdef DEBUG - free(m->tso->label); - m->tso->label = NULL; + removeThreadLabel((StgWord)m->tso); #endif main_threads = main_threads->link; if (m->tso->what_next == ThreadComplete) { @@ -1648,14 +1646,13 @@ void labelThread(StgTSO *tso, char *label) /* Caveat: Once set, you can only set the thread name to "" */ len = strlen(label)+1; - buf = realloc(tso->label,len); + buf = malloc(len); if (buf == NULL) { fprintf(stderr,"insufficient memory for labelThread!\n"); - free(tso->label); - tso->label = NULL; } else strncpy(buf,label,len); - tso->label = buf; + /* Update will free the old memory for us */ + updateThreadLabel((StgWord)tso,buf); } #endif /* DEBUG */ @@ -1720,10 +1717,6 @@ createThread(nat size) #endif tso->what_next = ThreadEnterGHC; -#ifdef DEBUG - tso->label = NULL; -#endif - /* tso->id needs to be unique. For now we use a heavyweight mutex to * protect the increment operation on next_thread_id. * In future, we could use an atomic increment instead. @@ -3583,6 +3576,7 @@ void printAllThreads(void) { StgTSO *t; + void *label; # if defined(GRAN) char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN]; @@ -3601,8 +3595,9 @@ printAllThreads(void) # endif for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) { - fprintf(stderr, "\tthread %d ", t->id); - if (t->label) fprintf(stderr,"[\"%s\"] ",t->label); + fprintf(stderr, "\tthread %d @ %p ", t->id, (void *)t); + label = lookupThreadLabel((StgWord)t); + if (label) fprintf(stderr,"[\"%s\"] ",(char *)label); printThreadStatus(t); fprintf(stderr,"\n"); }