summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstolz <unknown>2002-06-26 08:18:45 +0000
committerstolz <unknown>2002-06-26 08:18:45 +0000
commitfbbed914e114b6b55158319dca8956885f301ff5 (patch)
treef2d28a3edee7148887113f6345692778c1eb0c14
parent7ca3bb74a9acbcccc6dd8a84d03120e3a684fa9b (diff)
downloadhaskell-fbbed914e114b6b55158319dca8956885f301ff5.tar.gz
[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.
-rw-r--r--ghc/compiler/prelude/primops.txt.pp4
-rw-r--r--ghc/includes/TSO.h5
-rw-r--r--ghc/rts/PrimOps.hc8
-rw-r--r--ghc/rts/RtsStartup.c6
-rw-r--r--ghc/rts/Schedule.c29
5 files changed, 25 insertions, 27 deletions
diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp
index a1ff417c64..ade88b4b6b 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 06e8636ab5..19a162e036 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 0d2e75298b..44bedf6017 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 27ee47ca09..7b308eabe9 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 7e281e908c..530bdf9041 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");
}