-----------------------------------------------------------------------
--- $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
--
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
/* -----------------------------------------------------------------------------
- * $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
*
StgTSOBlockInfo block_info;
struct StgTSO_* blocked_exceptions;
StgThreadID id;
-#ifdef DEBUG
- char* label;
-#endif
StgTSOTickyInfo ticky;
StgTSOProfInfo prof;
/* -----------------------------------------------------------------------------
- * $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
*
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_
/* -----------------------------------------------------------------------------
- * $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
*
#include "Prelude.h" /* fixupRTStoPreludeRefs */
#include "HsFFI.h"
#include "Linker.h"
+#include "ThreadLabels.h"
#if defined(RTS_GTK_FRONTPANEL)
#include "FrontPanel.h"
/* initialise the stable pointer table */
initStablePtrTable();
+ /* initialise thread label table (tso->char*) */
+ initThreadLabelTable();
+
#if defined(PROFILING) || defined(DEBUG)
initProfiling1();
#endif
/* ---------------------------------------------------------------------------
- * $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
*
#include "Stats.h"
#include "Itimer.h"
#include "Prelude.h"
+#include "ThreadLabels.h"
#ifdef PROFILING
#include "Proftimer.h"
#include "ProfHeap.h"
m->stat = Success;
broadcastCondition(&m->wakeup);
#ifdef DEBUG
- free(m->tso->label);
- m->tso->label = NULL;
+ removeThreadLabel(m->tso);
#endif
break;
case ThreadKilled:
}
broadcastCondition(&m->wakeup);
#ifdef DEBUG
- free(m->tso->label);
- m->tso->label = NULL;
+ removeThreadLabel(m->tso);
#endif
break;
default:
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) {
/* 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 */
#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.
printAllThreads(void)
{
StgTSO *t;
+ void *label;
# if defined(GRAN)
char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
# 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");
}